Excel VBA - macro to choose workbook to paste into depending on persons name

[Lisa Harris]

Hi all,

Need to develop my macros further - write code for excel to choose the relevant workbook to open and paste the row information into. The code works perfectly at the moment pasting into one master workbook. Now need it to choose the managers relevant workbook which is saved on their desktop. Tried method of 'setting' their workbooks with 'IF' conditions, but wouldn't work. Then found using a cell to include the filename location - however, can't get this to work but can't see what I am doing wrong....checked the filepath is typed correctly etc. The filepath name is featured on the 'PMs own Wip' tab of their workbook on cell "A1":

[TABLE="width: 398"]
<tbody>[TR]
[TD][/TD]
[TD]Col A
[/TD]
[/TR]
[TR]
[TD]Row 1
[/TD]
[TD]C:\Users\user.name\Desktop\Project Manager WIP.xlsm
[/TD]
[/TR]
</tbody>[/TABLE]


The code I have added in for this element is

[Dim wb1 As Workbook
 Dim wb2 As Workbook
 Dim ws1 As Worksheet
 Dim ws2 As Worksheet
 
Set wb1 = ThisWorkbook 'Workbook 1
Set ws1 = wb1.Sheets("PMs own WIP") 'change to whatever sheet called
MsgBox ws1.Range("A1")
Set wb2 = GetObject(ws1.Range("A1"))
Set ws2 = wb2.Sheets("PMs own WIP") 'change to whatever sheet called
/CODE]

Any help would be much appreciated!! many thanks, Lisa 

Full code is:

[CODE]Sub PMLoopCopyPaste()
'
 Dim wb1 As Workbook
 Dim wb2 As Workbook
 Dim ws1 As Worksheet
 Dim ws2 As Worksheet
 
Set wb1 = ThisWorkbook 'Workbook 1
Set ws1 = wb1.Sheets("PMs own WIP") 'change to whatever sheet called
MsgBox ws1.Range("A1")
Set wb2 = GetObject(ws1.Range("A1"))
Set ws2 = wb2.Sheets("PMs own WIP") 'change to whatever sheet called
'
 
lr = ws1.Range("B" & Rows.Count).End(xlUp).ROW 'lastrow of data to get number of loops required
If lr = 1 Then Exit Sub 'exit if no data
For i = 2 To lr
    myVal = ws1.Range("B" & i).Value
    If myVal > 0 Then 'checks cell not just a zero
        lr2 = ws2.Range("B" & Rows.Count).End(xlUp).ROW 'lastrow of target worksheet
        With ws2.Range("B2:B" & lr2)
            Set c = .Find(myVal, LookIn:=xlValues, LookAt:=xlWhole)
            If Not c Is Nothing Then
                    ws1.Range("A" & i & ":AD" & i).Copy
                    ws2.Cells(c.ROW, 1).PasteSpecial xlPasteValues
                Else
                    ws1.Range("A" & i & ":AD" & i).Copy
                    ws2.Cells(lr2 + 1, 1).PasteSpecial xlPasteValues
                End If
            End With
        End If
    Next i
    Application.CutCopyMode = False
    Application.ScreenUpdating = True
 
 Range("A3").Select
    
    'then tells it to go back to cell A3 so not left at bottom of a spreadsheet
    
    
    Application.CutCopyMode = False
    ActiveWorkbook.Save
    ActiveWindow.Close
    
    'tells it to save WIP and then close it down
    
    
    Sheets("PMs Own WIP").Select
    Range("B2").Select
    Sheets("Workflow Brief").Select
    Range("A3").Select
    ActiveWorkbook.Save
    
    'tells it to go back to the workflow sheet and select workflow brief tab
    
    MsgBox "The PM WIP has successfully been updated.", vbInformation + vbOKOnly, "PM Update Complete"
    
    'provides a message box to confirm to user the update to WIP has happened
     
End Sub

 

[gallen]

At what point does it fail?

You can get the user's desktop using:

Dim sFilePath As String
sFilePath = Environ("USERPROFILE") & "\Desktop\Project Manager WIP.xlsm"

Then you can use :

Set wb = WorkBooks.Open(sFilePath)

to open the workbook.

This code doesn't check if the file exists but thats easy to do if needed. You could even get the user to select the file using a dialog box.

 

[Lisa Harris]

That has worked perfectly!! Thank you so much!

And apologies for posting this question twice - this was by accident and hadn't realised I had

Many thanks for your help! Lisa

 

[gallen]

That has worked perfectly!! Thank you so much!

And apologies for posting this question twice - this was by accident and hadn't realised I had

Many thanks for your help! Lisa

No problem. Hope the rest of the project goes well.