VBA Copy and pasta row based on cell value

[ssh99]

Hello. I'm a novice at VBA and am struggling to get a macro set up. Any help would be greatly appreciated.

What I need the macro to do
I have a list of excel workbooks already saved in a folder. The file name of each workbook is in column A of the spreadsheet I am using.
I need the macro to copy 1 row of data from columns B, C and D and paste it in the workbook corresponding to the same file name in column A. This data then needs to be pasted in the workbook of the relevant file.

The VBA code I have written so far
It seems to do what I need it to apart from pasting the row of data in the different workbooks. I suspect there is a problem with the 'WaitingListData' part of the code.

Here is the code:

Sub Macro1()

Dim previousAlertsFlag As Boolean

Dim masterWB As Workbook

Dim masterWS As Worksheet

Dim destWB As Workbook

Dim destWS As Worksheet

Dim lastRow As Long

Dim filepath As String

Dim fullpath As String

Dim country As String

Dim countryData As Variant

Dim r As Integer



Set masterWB = ThisWorkbook

Set masterWS = masterWB.Worksheets("Sheet1")

lastRow = masterWS.Cells(masterWS.Rows.Count, "A").End(xlUp).Row

filepath = "G:\Shared\Automated emails\"



For r = 2 To lastRow

User = masterWS.Cells(r, 1).Value

WaitingListData = masterWS.Cells(r, 2)(r, 3)(r, 4).Value

Selection.Copy

fullpath = filepath & User & ".xlsx"

Set destWB = Workbooks.Open(fullpath)

Set destWS = destWB.Sheets("Sheet1")

destWS.Cells(1, 2).Value = WaitingListData

destWB.Close SaveChanges:=True

Next r

End Sub

I have also attached a screenshot of the spreadsheet the data is being copied from.

Thanks for your help.

 

[JLGWhiz]

Replace your For r loop with this"

For r = 2 To LastRow
    User = masterWS.Cells(r, 1).Value
    fullpath = filepath & User & ".xlsx"
    Set destWB = Workbooks.Open(fullpath)
    Set destWS = destWB.Sheets("Sheet1")
    masterWS.Cells(r, 2).Resize(, 3).Copy destWS.Cells(1, 2)
    destWB.Close SaveChanges:=True
Next r

 

[ssh99]

Replace your For r loop with this"

For r = 2 To LastRow
    User = masterWS.Cells(r, 1).Value
    fullpath = filepath & User & ".xlsx"
    Set destWB = Workbooks.Open(fullpath)
    Set destWS = destWB.Sheets("Sheet1")
    masterWS.Cells(r, 2).Resize(, 3).Copy destWS.Cells(1, 2)
    destWB.Close SaveChanges:=True
Next r

Thank you, that's amazing! It's working perfectly now.

Do you know what I'd need to add if I needed to copy multiple rows of data for each spreadsheet. For example, if 'John' (taken from column 1) had data randomly placed in rows (say rows 3, 5 and 10 for example), how would I copy all the rows to the spreadsheet called 'John'? I'm guessing I'd need to add an auto filter code somewhere but have no clue how to do this.

 

[JLGWhiz]

You could loop to find "John" in column A and copy on each iteration, or more sophisticated maybe filter on "John" and use the SpecialCells(xlCellTypeVisible) to capture the data to copy. But that is beyond the scope of this thread and you would need to start a new thread for that issue.

 

[ssh99]

You could loop to find "John" in column A and copy on each iteration, or more sophisticated maybe filter on "John" and use the SpecialCells(xlCellTypeVisible) to capture the data to copy. But that is beyond the scope of this thread and you would need to start a new thread for that issue.

Thanks, you've been a big help.

 

[JLGWhiz]

Thanks, you've been a big help.

You're welcome,
regards, JLG