VBA Code To Combine Excel Files in a Folder.

[Navi_G]

Respected Experts,

Hi to All

I Need a VBA to combine data in different excel files in a folder.
For Example :
Data:
Excel 1 = Range (ABC)
Excel 2 = Range (DEF)
Excel 3 = Range (DEF)

Output
Master Sheet= (Range(ABC)(DEF)(DEF))
I need data in rows my rows change but column range not change.

Regards,
Navi_G

 

[AlanSidman]

I would use Power Query instead of VBA. In this manner, each time a table is updated, a click of the refresh button in Excel updates the combined data.

Google Search

 

[Navi_G]

i used thin client in my office MS office standard version 2016 so only vba helpful for me thanks for advice. please provide vba code.

 

[anishms]

i used thin client in my office MS office standard version 2016 so only vba helpful for me thanks for advice. please provide vba code.

I have a code which combines many workbooks into one worksheet

Option Explicit
Sub CombineWorkbooks()
    Dim strDirContainingFiles As String, strFile As String, strFilePath As String
    Dim wbkDst As Workbook, wbkSrc As Workbook
    Dim wksDst As Worksheet, wksSrc As Worksheet, xWS As Worksheet
    Dim lngIdx As Long, lngSrcLastRow As Long, lngSrcLastCol As Long, lngDstLastRow As Long, lngDstLastCol As Long, lngDstFirstFileRow As Long
    Dim rngSrc As Range, rngDst As Range, rngFile As Range
    Dim t0     As Double
    Dim colFileNames As Collection
    Set colFileNames = New Collection
    
    With Application.FileDialog(msoFileDialogFolderPicker)
        .Title = "Please select a folder"
        .Show
        .AllowMultiSelect = False
        If .SelectedItems.Count = 0 Then
            MsgBox "You did not select a folder."
            Exit Sub
        End If
        strDirContainingFiles = .SelectedItems(1) & "\"
    End With
    
    Set wbkDst = Workbooks.Add
    Set wksDst = wbkDst.ActiveSheet
    
    With Application
        .ScreenUpdating = False
        .DisplayAlerts = False
        .Calculation = xlCalculationManual
    End With
    
    strFile = Dir(strDirContainingFiles & "\*.xl*")
    Do While Len(strFile) > 0
        colFileNames.Add Item:=strFile
        strFile = Dir
    Loop
    
    If colFileNames.Count = 0 Then
        MsgBox "Hi " & Application.UserName & vbNewLine & vbNewLine _
             & "There are no excel files in this folder."
        wbkDst.Close
        Exit Sub
    Else
        MsgBox "Hi " & Application.UserName & vbNewLine & vbNewLine _
             & "There are " & colFileNames.Count & " excel files in this folder." & vbNewLine & _
               "All these files will be combined."
    End If
    
    t0 = CDbl(Now())
    
    For lngIdx = 1 To colFileNames.Count
        
        strFilePath = strDirContainingFiles & "\" & colFileNames(lngIdx)
        
        Set wbkSrc = Workbooks.Open(strFilePath)
        
        For Each xWS In wbkSrc.Sheets
            Set wksSrc = wbkSrc.Worksheets(xWS.Name)
            
            lngSrcLastRow = LastOccupiedRowNum(wksSrc)
            lngSrcLastCol = LastOccupiedColNum(wksSrc)
            With wksSrc
                If lngIdx = 1 And xWS.Index = 1 Then
                    Set rngSrc = .Range(.Cells(1, 1), .Cells(lngSrcLastRow, lngSrcLastCol))
                Else
                    Set rngSrc = .Range(.Cells(1, 1), .Cells(lngSrcLastRow, lngSrcLastCol))
                    Set rngSrc = rngSrc.Offset(1, 0).Resize(rngSrc.Rows.Count - 1)
                End If
            End With
            
            If lngIdx = 1 And xWS.Index = 1 Then
                lngDstLastRow = 1
                Set rngDst = wksDst.Cells(1, 1)
                
            Else
                lngDstLastRow = LastOccupiedRowNum(wksDst)
                Set rngDst = wksDst.Cells(lngDstLastRow + 1, 1)
            End If
            rngSrc.Copy Destination:=rngDst
            
            If lngIdx = 1 And xWS.Index = 1 Then
                lngDstLastCol = LastOccupiedColNum(wksDst)
                wksDst.Cells(1, lngDstLastCol + 1) = "Source Filename"
            End If
            
            With wksDst
                
                lngDstFirstFileRow = lngDstLastRow + 1
                
                lngDstLastRow = LastOccupiedRowNum(wksDst)
                lngDstLastCol = LastOccupiedColNum(wksDst)
                
                Set rngFile = .Range(.Cells(lngDstFirstFileRow, lngDstLastCol), _
                    .Cells(lngDstLastRow, lngDstLastCol))
                
                rngFile.Value = wbkSrc.Name
            End With
        Next xWS
        wbkSrc.Close savechanges:=False
        
        With wksDst
            DoEvents
            Application.StatusBar = "Combining Workbooks in to one Worksheet : " & Format(lngIdx / colFileNames.Count, "0.00%")
        End With
        
    Next lngIdx
    wksDst.Cells(1).EntireRow.Columns.AutoFit
    
    With Application
        .ScreenUpdating = True
        .DisplayAlerts = True
        .Calculation = xlCalculationAutomatic
        .StatusBar = False
    End With
    
    MsgBox Format(Now - t0, "hh:mm:ss"), vbInformation, "Completed!"
    
End Sub

Public Function LastOccupiedRowNum(Sheet As Worksheet) As Long
    Dim lng    As Long
    If Application.WorksheetFunction.CountA(Sheet.Cells) <> 0 Then
        With Sheet
            lng = .Cells.Find(What:="*", _
                  After:=.Range("A1"), _
                  Lookat:=xlPart, _
                  LookIn:=xlFormulas, _
                  SearchOrder:=xlByRows, _
                  SearchDirection:=xlPrevious, _
                  MatchCase:=False).Row
        End With
    Else
        lng = 1
    End If
    LastOccupiedRowNum = lng
End Function

Public Function LastOccupiedColNum(Sheet As Worksheet) As Long
    Dim lng    As Long
    If Application.WorksheetFunction.CountA(Sheet.Cells) <> 0 Then
        With Sheet
            lng = .Cells.Find(What:="*", _
                  After:=.Range("A1"), _
                  Lookat:=xlPart, _
                  LookIn:=xlFormulas, _
                  SearchOrder:=xlByColumns, _
                  SearchDirection:=xlPrevious, _
                  MatchCase:=False).Column
        End With
    Else
        lng = 1
    End If
    LastOccupiedColNum = lng
End Function