How to copy rows of data from multiple workbooks based on an variable criteria, then paste into a master workbook

Question

I am very new to VBA and after hours of searching I have found a code to copy all rows of data from multiple workbooks into a master workbook. The data in the user workbooks is updated daily. However, I do not wish to delete the data from the user workbooks so when I run the macro for a second time to capture the new data, it copies all the rows again and therefore duplicates the data in the master workbook. Column T of the workbooks contains the week number of the entry of the row of data. I would like to use an input box to specify the week number to search for, then copy the entire row. This way I can run the macro once a week but only update the master with the previous weeks data instead of the entire worksheet. Here is the macro I currently have. Please can anyone help to modify it?

    Sub copyDataFromMultipleWorkbooksIntoMaster()

    Dim FolderPath As String, Filepath As String, Filename As String

    FolderPath = "C:\Users\25dbrown\Desktop\Prototypes\"

    Filepath = FolderPath & "*.xlsx*"

    Filename = Dir(Filepath)

    Dim lastrow As Long, lastcolumn As Long

    Do While Filename <> ""
     Workbooks.Open (FolderPath & Filename)
     lastrow = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row
     lastcolumn = ActiveSheet.Cells(1, Columns.Count).End(xlToLeft).Column
     Range(Cells(2, 1), Cells(lastrow, lastcolumn)).Copy
     Application.DisplayAlerts = False
     ActiveWorkbook.Close

     erow = Sheet1.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
     lastcolumn = ActiveSheet.Cells(1, Columns.Count).End(xlToLeft).Column
     ActiveSheet.Paste Destination:=Worksheets("2015").Rang(Cells(erow,1),  Cells(erow, lastcolumn))                


     Filename = Dir

     Loop

     End Sub

findwindow findwindow · Accepted Answer · 2015-06-30T21:16:56

NOT tested. The For Loop is mostly what you're looking for.

Sub copyDataFromMultipleWorkbooksIntoMaster()

Dim FolderPath As String, Filepath As String, Filename As String

FolderPath = "C:\Users\25dbrown\Desktop\Prototypes\"
Filepath = FolderPath & "*.xlsx*"
Filename = Dir(Filepath)

Dim week As Long
Dim tag As Long
Dim lastrow As Long
Dim sourcewb As Workbook
Dim ws2015 As Worksheet

week = InputBox("Which week?")
Set ws2015 = ThisWorkbook.Worksheets("2015")

Do While Filename <> ""

erow = ws2015.Cells(Rows.Count, 1).End(xlUp).Row

Set sourcewb = Workbooks.Open(FolderPath & Filename)
lastrow = sourcewb.ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row   'suggest changing activesheet to worksheet("name")

'loop through column T for the specified week
For i = 1 To lastrow
    If sourcewb.ActiveSheet.Cells(i, 20).Value = week Then  'suggest changing activesheet to worksheet("name")
    'upon match store that row to a variable for copying
    tag = i
    Exit For
    End If
Next

sourcewb.Worksheets(1).Rows(tag).Copy   'suggest changing worksheet to worksheet("name")
ws2015.Cells(erow, 1).PasteSpecial

sourcewb.close

Filename = Dir

Loop

End Sub

How to copy rows of data from multiple workbooks based on an variable criteria, then paste into a master workbook

1 Answers