Macro to copy from one sheet to another

[dm64]

Hi there

Hopefully one of the experts can assist - Im dabbing in VBA without knowing it well

I have two sheets both with some protected cells (columns) but I want to allow a user to move rows from one sheet to the other. Both sheets are setup exactly the same.

So via some googling I have come up with the VBA below but it isnt quite working for me.

Here is my logic

1. Via an input box I have the user select which line want to move from "Pipeline" (that part is working fine), automatically unprotect the sheet and copy the row
2. Then go to the "Project Tracker", automatically unprotect the sheet, locate the last empty row and paste (this isnt yet working)
3. And I havent built this in yet, go back to the row that was selected in "Pipeline" and delete it


The code I have so far is below.....Im stuck at getting it to actually paste

Thanks for your help!


Sub MoveFromPipelinetoTracker()
'
' MoveFromPipelinetoTracker Macro
' Macro recorded 7/03/2011 by L036328
'


Sheets("Pipeline").Activate
Worksheets("Pipeline").Protect Password:="merlot", UserInterfaceOnly:=True


Dim a As Long, response As Long
a = Application.InputBox( _
Prompt:="Enter the Rownumber you want to move to the Tracker", _
Title:="Move rownumber:", Type:=1)
If a <> False Then
response = MsgBox("Are you sure.", vbYesNo)
If response = vbYes Then Rows(a).Copy
End If

Sheets("Project Tracker").Activate
Worksheets("Project Tracker").Protect Password:="merlot", UserInterfaceOnly:=True
Range("A65536").End(xlUp).Offset(1, 0).Select
Sheets("Project Tracker").Paste

End Sub

 

[tusharm]

Should you be using Worksheets("Project Tracker").Protect? Or should it be Unprotect?

Also, check the logic for those instances when you get false or vbNo as the responses to your questions. Test the current logic and you will see it is incorrect.

 

[dm64]

Thanks Tusham

With the Protect/Unprotect - Im not quite sure there. The UserInterfaceOnly command was something I Googled and it only seems to work with "Protect"...from what I could understand though it would allow the sheet to be used like an unprotected sheet for the duration of the macro....am I correct there?????

The logic around the Vbno - that seems to be OK, it just ends the macro and thats fine with me.

The issue I have is that I cant get paste the final paste command.....and thats probably due to my lack of understanding of VB

Thanks - any thoughts would be greatly appreciated.

Dennis

 

[dm64]

Hi everyone

I think I have a solution......firstly I have place this code


Private Sub Workbook_Open()

Dim wSheet As Worksheet

For Each wSheet In Worksheets
wSheet.Protect Password:="Secret", _
UserInterFaceOnly:=True

Next wSheet


End Sub






In the Private Module for the worksheet (this is done by right clicking the Excel Icon to the left of File Menu item, selecting View Code and pasting it...I then saved and reopened the work book. This will ensure this code is run each time the book is opened.

From my understanding this sets the UserInterface to True....or perhaps described "open to macros".....macros will run on protected cells while still leaving them locked for users.




I then amended my code to....



Sub MoveFromPipelinetoTracker()
'
' MoveFromPipelinetoTracker Macro
' Macro recorded 7/03/2011 by L036328
'


Sheets("Pipeline").Activate

Dim a As Long, response As Long

a = Application.InputBox( _
Prompt:="Enter the Rownumber you want to move to the Tracker", _
Title:="Move rownumber:", Type:=1)
If a <> False Then
response = MsgBox("Are you sure.", vbYesNo)
If response = vbYes Then Rows(a).Copy
End If

Sheets("Project Tracker").Select
Range("A65536").End(xlUp).Offset(1, 0).Select
Selection.PasteSpecial paste:=xlAll, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False

Sheets("Pipeline").Select
Rows(a).EntireRow.Delete


End Sub



This now allows a user to select what Row they want to move from one sheet to the other.....the macro then copies that row to the first blank row of the second sheet, then goes back and deletes the originally selected row

 

[dm64]

Ahhh - Tusharm was correct about the Vbno logic.....here is my final working code

Sub MoveFromPipelinetoTracker()
'
' MoveFromPipelinetoTracker Macro
' Macro recorded 7/03/2011 by L036328
'


Sheets("Pipeline").Activate

Dim a As Long, response As Long

a = Application.InputBox( _
Prompt:="Enter the Row Number you want to MOVE to the Tracker", _
Title:="Move rownumber:", Type:=1)
If a <> False Then
response = MsgBox("MOVE Row" & (a) & " " & "Are you sure?", vbYesNo)
If response <> vbYes Then
Exit Sub
End If

If response = vbYes Then Rows(a).Copy
End If

Sheets("Project Tracker").Select
Range("A65536").End(xlUp).Offset(1, 0).Select
Selection.PasteSpecial paste:=xlAll, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False

Sheets("Pipeline").Select
Rows(a).EntireRow.Delete



End Sub

 

[tusharm]

LOL! I usually am when it comes to reviewing code. {grin}

You still have a problem. If the customer cancels your initial app.inputbox, the method returns false. But you are assigning it to a long. Therefore it will become 0.

When you test 0 <> False the test will be false. So, you will skip all the code inside that If.

Consequently, you will next execute the statements starting with
Sheets("Project Tracker").Select
That means you will attempt to paste whatever is in the clipboard into that worksheet. Since the contents of the clipboard are unknown, the code may work in which case your worksheet will be corrupt. Or the paste may fail in which case the code will fault.

Ahhh - Tusharm was correct about the Vbno logic.....here is my final working code

Sub MoveFromPipelinetoTracker()
'
' MoveFromPipelinetoTracker Macro
' Macro recorded 7/03/2011 by L036328
'


Sheets("Pipeline").Activate

Dim a As Long, response As Long

a = Application.InputBox( _
Prompt:="Enter the Row Number you want to MOVE to the Tracker", _
Title:="Move rownumber:", Type:=1)
If a <> False Then
response = MsgBox("MOVE Row" & (a) & " " & "Are you sure?", vbYesNo)
If response <> vbYes Then
Exit Sub
End If

If response = vbYes Then Rows(a).Copy
End If

Sheets("Project Tracker").Select
Range("A65536").End(xlUp).Offset(1, 0).Select
Selection.PasteSpecial paste:=xlAll, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False

Sheets("Pipeline").Select
Rows(a).EntireRow.Delete



End Sub

 

[dm64]

Spot on yet again....thanks!