Pulling Specific Data from multiple separate excel files into one Master File

[adefonzo23]

I have created a folder with (roughly) 30 copies of the same Weekly Work Plan file for all my sub-contractors for them to update weekly

Each Trade Partner file has a "Data" tab and a "Weekly Work Plan" tab, and the Master file has those plus another tab to track Planned Percentage Complete.

I now am trying to create a VBA and/or Macro in my "00_OH-MOB Master WWP" file - in the Weekly Work Plan tab, which would include a "button", so that once a week, I can run that Macro (push that button), and it will pull all of the data entered from my sub-contractors in the Weekly Work Plan tabs of their individual files, into the Master.

I already have the template set up in the Master File, which follows the same column headers as the individual files (the only difference being the cells indicating "Master Weekly Workplan" vs. "Trade Partner Weekly Workplan :

I've been online watching videos and trying to read through message boards, but nothing I found seemed to address my specific quandry. Can anyone help out with the process that's needed to get this done? Much thanks to anyone who can help out.

 

[mumps]

My bad. Just delete the comma in:

.PasteSpecial , xlPasteValues

 

[adefonzo23]

My bad. Just delete the comma in:

.PasteSpecial , xlPasteValues

another error code leads to this:

 

[mumps]

Is there a sheet named “Master WWP” in your Master workbook? If not, you will get an error.

 

[adefonzo23]

Is there a sheet named “Master WWP” in your Master workbook? If not, you will get an error.

Yes, the tab/sheet that I am trying to copy into is titled Master WWP...I trust the quotation marks are part of the code as they are not in the actual title of the tab

 

[mumps]

Could you upload a copy of the Master file and one of the Trade Partner files both de-sensitized if necessary to a free file sharing site like DropBox and post links to the files here?

 

[adefonzo23]

Andrew DeFonzo sent you 2 items

00_OH MOB MASTER WWP.xlsm + 1 more item

www.dropbox.com

Hope that works

 

[adefonzo23]

apologies...please try this link if the one above does not work

Dropbox

www.dropbox.com

 

[mumps]

Try:

Sub CopyWeeklyData()
    Application.ScreenUpdating = False
    Dim desWS As Worksheet, srcWB As Workbook, lRow As Long
    Set desWS = ThisWorkbook.Sheets("Master WWP")
    desWS.UsedRange.Offset(5).ClearContents
    Const strPath As String = "C:\Users\adefonzo\OneDrive - Turner Construction\OH_MOB_Weekly Work Plans\"
    ChDir strPath
    strExtension = Dir(strPath & "*.xlsx")
    Do While strExtension <> ""
        Set srcWB = Workbooks.Open(strPath & strExtension)
        With srcWB
            With .Sheets("Weekly Work Plan")
                lRow = .Columns("B").Find("*", SearchDirection:=xlPrevious, SearchOrder:=xlByRows, LookIn:=xlValues).Row
                .Range("B6:Q" & lRow).Copy
                desWS.Cells(desWS.Rows.Count, "B").End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
            End With
            .Close savechanges:=False
        End With
        strExtension = Dir
    Loop
    Application.CutCopyMode = False
    Application.ScreenUpdating = True
End Sub

 

[adefonzo23]

Try:

Sub CopyWeeklyData()
    Application.ScreenUpdating = False
    Dim desWS As Worksheet, srcWB As Workbook, lRow As Long
    Set desWS = ThisWorkbook.Sheets("Master WWP")
    desWS.UsedRange.Offset(5).ClearContents
    Const strPath As String = "C:\Users\adefonzo\OneDrive - Turner Construction\OH_MOB_Weekly Work Plans\"
    ChDir strPath
    strExtension = Dir(strPath & "*.xlsx")
    Do While strExtension <> ""
        Set srcWB = Workbooks.Open(strPath & strExtension)
        With srcWB
            With .Sheets("Weekly Work Plan")
                lRow = .Columns("B").Find("*", SearchDirection:=xlPrevious, SearchOrder:=xlByRows, LookIn:=xlValues).Row
                .Range("B6:Q" & lRow).Copy
                desWS.Cells(desWS.Rows.Count, "B").End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
            End With
            .Close savechanges:=False
        End With
        strExtension = Dir
    Loop
    Application.CutCopyMode = False
    Application.ScreenUpdating = True
End Sub

We're getting very close. This did pull data from all of the other sheets, but what seems to happen is any of the sub-contractor sheets that do not have any data entered, the code is pulling row 5 (which is the column headers) from those sheets.

Again, I really appreciate all your patience in helping to get this up and running.

 

[mumps]

Try:

Sub CopyWeeklyData()
    Application.ScreenUpdating = False
    Dim desWS As Worksheet, srcWB As Workbook, lRow As Long
    Set desWS = ThisWorkbook.Sheets("Master WWP")
    desWS.UsedRange.Offset(5).ClearContents
    Const strPath As String = "C:\Users\adefonzo\OneDrive - Turner Construction\OH_MOB_Weekly Work Plans\"
    ChDir strPath
    strExtension = Dir(strPath & "*.xlsx")
    Do While strExtension <> ""
        Set srcWB = Workbooks.Open(strPath & strExtension)
        With srcWB
            With .Sheets("Weekly Work Plan")
                If .Range("B6") <> "" Then
                    lRow = .Columns("B").Find("*", SearchDirection:=xlPrevious, SearchOrder:=xlByRows, LookIn:=xlValues).Row
                    .Range("B6:Q" & lRow).Copy
                    desWS.Cells(desWS.Rows.Count, "B").End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
                End If
            End With
            .Close savechanges:=False
        End With
        strExtension = Dir
    Loop
    Application.CutCopyMode = False
    Application.ScreenUpdating = True
End Sub