Help VBA code for Consolidating multiple workbooks with sheet names into a single workbook

[vrajesh544]

I have a multiple workbook data and
need a single workbook (Master file) and also
need workbook names as well. (index workbook name use to separate column in a consolidated data)

 

[MARK858]

Welcome to the board, as it is a pretty generic request I would suggest trying Ron de Bruin's Addin

Home | Ron de Bruin Excel Automation

Welcome to https://www.rondebruin.nl

www.rondebruin.nl

 

[maabadi]

Welcome to MrExcel Message board.
Try Link give by Mark858, if Not satisfied, answer these questions and if possible upload one example sheet with structure of your workbooks with XL2BB Add-in here.

1. how many worksheet at each workbook should be extracted? & what is names?
2. Data at each sheet start form same row & column or Not? if yes, what is first row & column?
3. how many rows consider as heading and at all worksheets is same?
4. you want result at one sheet or each workbook at separate sheet?

 

[vrajesh544]

Welcome to MrExcel Message board.
Try Link give by Mark858, if Not satisfied, answer these questions and if possible upload one example sheet with structure of your workbooks with XL2BB Add-in here.

1. how many worksheet at each workbook should be extracted? & what is names?
2. Data at each sheet start form same row & column or Not? if yes, what is first row & column?
3. how many rows consider as heading and at all worksheets is same?
4. you want result at one sheet or each workbook at separate sheet?

1. Only one sheet. & (Sheet name as sheet name) example each workbook name as sheet name.
2.same row & last column. Yes, first row is Date & column (w)
3. Only one row is header & at all worksheets is same.
4. Result get all in single workbook.

 

[maabadi]

Thanks for reply but tell exactly:
1. first row number is 1 or ... ?
2. I think you want all result on one sheet?
3. Columns arrangement at all file is same or different (e.g if Same then Title row at all file is Date, name, ID, .... Respectively)

 

[maabadi]

if answer of all question is yes and have same arrangement columns and all excel files at one folder try this:
Note: when you see Select folder window only select folder that have excel file and don't open it
1. Change Red part if Sheet name isn't same with Workbook name, e.g if sheet name at all workbook is Sheet1 Change xStrAWBName to "Sheet1"
2. At Blue part you can change Destination Sheet name, if you want another name change it

Sub ImportFiles3()
Dim xWS As Worksheet, xTWB As Workbook, DestSheet As Worksheet, Head As Range
Dim xStrAWBName As String, FolderName As String, sItem As String, Header As Long
Dim FolderPath As String, fldr As FileDialog, Lr As Long, LCD As Long, R As Long
Dim os As Long, LrS As Long, LCS As Long, FileName As String
On Error Resume Next
Set xTWB = ThisWorkbook
Set DestSheet = xTWB.ActiveSheet
  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
For Each xWS In ActiveWorkbook.Sheets
If xWS.Name = xStrAWBName Then
Lr = DestSheet.Range("A" & Rows.Count).End(xlUp).Row
LrS = xWS.Range("A" & Rows.Count).End(xlUp).Row
LCS = xWS.Cells(1, Columns.Count).End(xlToLeft).Column + 1
LCD = DestSheet.Cells(1, Columns.Count).End(xlToLeft).Column + 1
If Lr = 1 Then
Range(DestSheet.Cells(1, 2), DestSheet.Cells(Lr, LCS)).Value = Range(xWS.Cells(1, 1), xWS.Cells(Lr, LCS - 1)).Value
DestSheet.Range("A1").Value = "FileName"
DestSheet.Range("A2:A" & Lr).Value = xStrAWBName
Else
Range(DestSheet.Cells(Lr + 1, 2), DestSheet.Cells(Lr + LrS - 1, LCS)).Value = Range(xWS.Cells(2, 1), xWS.Cells(Lr, LCS - 1)).Value
DestSheet.Range("A" & Lr + 1 & ":A" & Lr + LrS - 1).Value = xStrAWBName
End If
End If
Next xWS
Workbooks(xStrAWBName).Close
FileName = Dir()
Loop
DestSheet.Activate
DestSheet.Name = "Consolidate"
xTWB.Save
Application.ScreenUpdating = True
Application.DisplayAlerts = True
Application.Calculation = xlCalculationAutomatic
End Sub

 

[alansidman]

Look at this link on how to do this in Power Query