Consolidate all values from specific sheets into 1 master excel file

[yrga88]

I have master excel file with some of sheets names are ("abc", "def", and "ghi"). In the same folder as master excel, there is 1 folder named 'Data' where inside it there are 20 excel workbooks which also has same sheet names ( "abc", "def", and "ghi"). I want to have vba codes inside the master workbook to copy paste and consolidate all values in each of these sheet names ("abc", "def", and "ghi") from 20 excel workbooks to master excel file.

I can provide with dummy data if that's needed.

Thank you!

 

[Trebor76]

Hi yrga88,

Welcome to MrExcel!!

See how this goes:

Option Explicit
Sub Macro1()
    
    Dim strSrcPath As String, strFile As String
    Dim wb As Workbook
    Dim blnWasFileOpen As Boolean
    Dim wsSrc As Worksheet, wsDestin As Worksheet
    Dim varSheets As Variant
    Dim i As Long
    Dim strCopyRange As String
    
    strSrcPath = "C:\Users\yrga88\Desktop" 'Directory path containing Excel files. Change to suit.
    strSrcPath = IIf(Right(strSrcPath, 1) <> "\", strSrcPath & "\", strSrcPath)
    strFile = Dir(strSrcPath & "*.xls*") 'Consolidate Excel files only
    varSheets = Array("abc", "def", "ghi") 'Sheet names to be consolidated. Change to suit.
    
    Application.ScreenUpdating = False
    
    If Dir(strSrcPath, vbDirectory) = "" Then
        MsgBox "The path """ & strSrcPath & """ is invalid." & vbNewLine & "Please check and try again.", vbExclamation
        Exit Sub
    End If
    
    Do While Len(strFile) > 0
        On Error Resume Next
            Set wb = Workbooks(CStr(strFile))
            If Err.Number <> 0 Then
                Set wb = Workbooks.Open(strSrcPath & strFile, UpdateLinks:=False, ReadOnly:=True)
            Else
               blnWasFileOpen = True
            End If
        On Error GoTo 0
        For Each wsSrc In wb.Worksheets
            If IsNumeric(Application.Match(wsSrc.Name, varSheets, 0)) Then
                Call UnhideShowAll(wsSrc)
                Set wsDestin = ThisWorkbook.Sheets(CStr(wsSrc.Name))
                Call UnhideShowAll(wsDestin)
                strCopyRange = Split(wsSrc.UsedRange.Offset(1, 0).Address, ":")(0) 'Assumes Row 1 is for headings. Change offset number to suit.
                strCopyRange = strCopyRange & ":" & Split(wsSrc.UsedRange.Address, ":")(1)
                On Error Resume Next
                    i = wsDestin.Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row + 1
                    i = IIf(i = 0, 2, i)
                On Error GoTo 0
                wsSrc.Range(strCopyRange).Copy Destination:=wsDestin.Range("A" & i)
            End If
        Next wsSrc
        If blnWasFileOpen = False Then
            Application.DisplayAlerts = False
                wb.Close SaveChanges:=False
            Application.DisplayAlerts = True
        End If
        blnWasFileOpen = False
        strFile = Dir
    Loop
    
    Application.ScreenUpdating = True
    
    MsgBox "Files have now been consolidated.", vbInformation

End Sub

Regards,

Robert