Macro to consolidate specific data from 15 sheets to 1

[bomijoff]

Hello!
I have 15 sepereate worksheets used by different people ("Sheet1","Sheet2" etc), each of which have 2 tabs "Consolidated" & "Completed Consolidated".
I download all 15 worksheets into a folder "Pipeline Update".
I then have a worksheet called "Master" which has 2 tabs like the above "Consolidated" & "Completed Consolidated" that i need to copy from those 15 into this single worksheet.

At the moment what i do is open the "Master" worksheet and delete the old data in both tabs in range B7:AQ7 (there is data around the range which needs to stay).

I then open "Sheet1", click on the "Consolidated" tab, copy the data range from B7:AQ7, paste into the "Consolidated" tab in "Master" worksheet, then do the same for the "Compelted Consolidated" tab (same range) into the "Completed Consolidated" tab in the "Master" worksheet, i do this for the other 14 sheets.

What i'm trying to do is automate this instead of manually copy/pasting data, by creating a button with the macro "Update".

Things to note:
"Compelted Consolidated" tab for the 15, may have nothing in the range to copy over.
Sometimes (not always) there are filters/hidden rows, i need all the data in that range copied over.
I'm hoping for no gaps in the rows when the data is copied over.

Example image of "Sheet1" Consolidated data tab data that i need to copy over.

Hope that made sense, any help would be amazing!

 

[mumps]

Change the folder path (in red) to suit you needs. Place the macro in the Master file.

Sub CopyRange()
    Application.ScreenUpdating = False
    Dim wkbDest As Workbook, wkbSource As Workbook, ws As Worksheet, LastRow As Long
    Set wkbDest = ThisWorkbook
    Const strPath As String = "C:\Pipeline Update\" 'change folder path to suit your needs
    For Each ws In wkbDest.Sheets(Array("Consolidated", "Completed Consolidated"))
        With ws
            LastRow = .Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
            .Range("B7:AQ" & LastRow).ClearContents
        End With
    Next ws
    ChDir strPath
    strExtension = Dir(strPath & "*.xlsx")
    Do While strExtension <> ""
        Set wkbSource = Workbooks.Open(strPath & strExtension)
        For Each ws In Sheets(Array("Consolidated", "Completed Consolidated"))
            With ws
                If .AutoFilterMode = True Then .AutoFilterMode = False
                LastRow = .Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
                If LastRow > 7 Then
                    .Range("B7:AQ" & LastRow).Copy wkbDest.Sheets(ws.Name).Cells(wkbDest.Sheets(ws.Name).Rows.Count, "B").End(xlUp).Offset(1)
                End If
            End With
        Next ws
        wkbSource.Close savechanges:=False
        strExtension = Dir
    Loop
    Application.ScreenUpdating = True
End Sub

 

[bomijoff]

Change the folder path (in red) to suit you needs. Place the macro in the Master file.

Sub CopyRange()
    Application.ScreenUpdating = False
    Dim wkbDest As Workbook, wkbSource As Workbook, ws As Worksheet, LastRow As Long
    Set wkbDest = ThisWorkbook
    Const strPath As String = "C:\Pipeline Update\" 'change folder path to suit your needs
    For Each ws In wkbDest.Sheets(Array("Consolidated", "Completed Consolidated"))
        With ws
            LastRow = .Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
            .Range("B7:AQ" & LastRow).ClearContents
        End With
    Next ws
    ChDir strPath
    strExtension = Dir(strPath & "*.xlsx")
    Do While strExtension <> ""
        Set wkbSource = Workbooks.Open(strPath & strExtension)
        For Each ws In Sheets(Array("Consolidated", "Completed Consolidated"))
            With ws
                If .AutoFilterMode = True Then .AutoFilterMode = False
                LastRow = .Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
                If LastRow > 7 Then
                    .Range("B7:AQ" & LastRow).Copy wkbDest.Sheets(ws.Name).Cells(wkbDest.Sheets(ws.Name).Rows.Count, "B").End(xlUp).Offset(1)
                End If
            End With
        Next ws
        wkbSource.Close savechanges:=False
        strExtension = Dir
    Loop
    Application.ScreenUpdating = True
End Sub

Thanks for your help mumps, i changed the folder path to the correct place with a \ at the end, however i get a runtime error saying subript out of range for this part:
For Each ws In wkbDest.Sheets(Array("Consolidated", "Completed Consolidated"))
do you know what the fix for that is? Also if you don't mind i'm new to VBA and would love to understand why the error would occur, along with the fix!

 

[mumps]

The macro is looking for the two sheets named in that line of code in the Master workbook. Do those two sheets exist in the Master?

 

[bomijoff]

The macro is looking for the two sheets named in that line of code in the Master workbook. Do those two sheets exist in the Master?

Yes they do, i've attached in the 1st picture on the left side is the Master workbook which i need to populate with the correctly names tabs, on the right is one of the 15 workbooks with example data,
image 2 is the error highlight.

 

[bomijoff]

I put the macro into the actual worksheet i will be using it for and it worked! i'm not sure why it didn't before but just wanted to say thank you so much mumps, this will save me loads of time!

 

[mumps]

You are very welcome.