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":

	Col A
Row 1	C:\Users\user.name\Desktop\Project Manager WIP.xlsm

<tbody>
</tbody>

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

 

[Peter_SSs]

Duplicate to http://www.mrexcel.com/forum/excel-questions/967531-excel-visual-basic-applications-macro-choose-workbook-paste-into-depending-persons-name.html

Please do not post the same question multiple times. Questions of a duplicate nature will be locked or deleted, per #12 of the Forum Rules and points 6 & 7 of the Forum Use Guidelines.

Any bumps, clarifications, or follow-ups should be posted to the linked thread.