VBA Code to Combine Multiple Workbooks into one Worksheet

[BrittKnee]

Hi! I want to combine data in multiple worksheets into one master worksheet in a separate workbook. All files are located in the same folder, so it would just need to loop to copy/paste into the master workbook's combined worksheet. I would like to house the macro in a separate workbook. Any help is appreciated. Below are screenshots of the folder with all of the workbooks and the Master Workbook. Files export_1-2 through export_T need to be copied into the worksheet named Combined_Results in Combine_Susp_Qry_Results.xlsx Any help is appreciated.

 

[Fluff]

@Nuppu As your question is significantly different than this thread, please start a new thread for your question.

 

[Jrohira2004]

Hi,

on the above macro i also need the name of the workbook from which data came. i have 7 workbooks - i need to consolidate data and then enter the name of workbook in last column.

Also is there i a macro to pick only headings which are common across all workbook

 

[Chandru96]

Sorry my fault. First change Sheet1 at code to your sheet name then use this macro:

Sub ImportFiles()
Dim strPath As String, xStrPath As String, xStrName As String, xStrFName As String
Dim xWS As Worksheet, xTWB As Workbook, DestSheet As Worksheet, FileName As String
Dim xStrAWBName As String, Sh1 As Worksheet, FolderName As String, sItem As String
Dim FolderPath As String, fldr As FileDialog, Lr As Long, Lc As Long, Lr2 As Long
On Error Resume Next
Set xTWB = ThisWorkbook
Set DestSheet = xTWB.ActiveSheet
Debug.Print DestSheet.Name
  Set fldr = Application.FileDialog(msoFileDialogFolderPicker)
    With fldr
        .Title = "Select a Folder"
        .AllowMultiSelect = False
        .InitialFileName = Application.DefaultFilePath
        If .Show <> -1 Then GoTo NextCode
        sItem = .SelectedItems(1)
    End With
NextCode:
    FolderName = sItem
    Set fldr = Nothing
    FolderPath = FolderName & "\"
  
FileName = Dir(FolderPath & "*.xls*")
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Application.DisplayAlerts = False
Do While FileName <> ""
Workbooks.Open FileName:=FolderPath & FileName, ReadOnly:=True
xStrAWBName = ActiveWorkbook.Name
Set Sh1 = ActiveWorkbook.Sheets("Sheet1")
xStrName = Sh1.Name
For Each xWS In ActiveWorkbook.Sheets
If xWS.Name = xStrName Then
Lr = DestSheet.Range("A" & Rows.Count).End(xlUp).Row
Lr2 = xWS.Range("A" & Rows.Count).End(xlUp).Row
Lc = Cells(1, Columns.Count).End(xlToLeft).Column
If Lr = 1 Then
Range(xWS.Cells(1, 1), xWS.Cells(Lr2, Lc)).Copy DestSheet.Range("A1")
Else
Range(xWS.Cells(2, 1), xWS.Cells(Lr2, Lc)).Copy DestSheet.Range("A" & Lr + 1)
End If
End If
Next xWS
Workbooks(xStrAWBName).Close
FileName = Dir()
Loop
xTWB.Save
Application.ScreenUpdating = True
Application.DisplayAlerts = True
Application.Calculation = xlCalculationAutomatic
End Sub

Hi, I think this code is what I am looking for. However, the excel files I have don't have same name for the worksheets and I have close to 70 excel files. So is it possible to still fetch data from excel without the sheets having the same name? This will really help me out. Thanks.