Carin, I missed something in my commentary above. I inserted a backslash in the assignment for XlFolder, but it should be omitted as the backslash is already accounted for in the .SaveAs Filename lines. More importantly, I'm not sure the code will do what you want. You mentioned "get multiple files from a folder to append into one file." I'm assuming the multiple files have a very similar structure. Is it your intention to append by row, or by column?
For example, if testfile1 is...
| MrExcel20210203_Carin.xlsx |
|---|
|
|---|
| A | B |
|---|
| 1 | a | 1 |
|---|
| 2 | b | 2 |
|---|
| 3 | c | 3 |
|---|
|
|---|
and testfile2 is...
| MrExcel20210203_Carin.xlsx |
|---|
|
|---|
| A | B | C |
|---|
| 1 | d | 4 | 7 |
|---|
| 2 | e | 5 | 8 |
|---|
| 3 | f | 6 | 9 |
|---|
|
|---|
Is this what the final product should look like...appended by row?
| MrExcel20210203_Carin.xlsx |
|---|
|
|---|
| A | B | C |
|---|
| 1 | | | |
|---|
| 2 | Appended file results | | |
|---|
| 3 | a | 1 | |
|---|
| 4 | b | 2 | |
|---|
| 5 | c | 3 | |
|---|
| 6 | d | 4 | 7 |
|---|
| 7 | e | 5 | 8 |
|---|
| 8 | f | 6 | 9 |
|---|
|
|---|
Or are you looking for a final product like this...appended by column?
| MrExcel20210203_Carin.xlsx |
|---|
|
|---|
| A | B | C | D | E |
|---|
| 1 | | | | | |
|---|
| 2 | a | 1 | d | 4 | 7 |
|---|
| 3 | b | 2 | e | 5 | 8 |
|---|
| 4 | c | 3 | f | 6 | 9 |
|---|
|
|---|
The above were done with three sets of code:
1) one consolidates multiple .xls, .xlsx., and .xlsm files into one workbook, with each worksheet taking the name of its source workbook. The user is given a file explorer window to navigate to and select the multiple files that should be incorporated into the working Workbook.
2) another operates on all worksheets in the working Workbook and appends all sheets by column
3) another operates on all worksheets in the working Workbook and appends all sheets by row
For convenience, I named the top level worksheet "Carin" and placed the three sets of VBA code in separate modules of that sheet. Then the first code is run (MergeExcelFiles), selecting which files should be added to the workbook. Then either 2 or 3 are run to append by column or row, and a new sheet is created with the appended/consolidated content. Because the latter two VBA codes use all of the sheets in the workbook, you won't want to run both (2 and 3) in the same session.
VBA Code:
' VBA code below sourced from...
' https://www.ablebits.com/office-addins-blog/2017/11/08/merge-multiple-excel-files-into-one/#combine-Excel-files-VBA
Sub MergeExcelFiles()
Dim fnameList, fnameCurFile As Variant
Dim countFiles, countSheets As Integer
Dim wksCurSheet As Worksheet
Dim wbkCurBook, wbkSrcBook As Workbook
fnameList = Application.GetOpenFilename(FileFilter:="Microsoft Excel Workbooks (*.xls;*.xlsx;*.xlsm),*.xls;*.xlsx;*.xlsm", Title:="Choose Excel files to merge", MultiSelect:=True)
If (vbBoolean <> VarType(fnameList)) Then
If (UBound(fnameList) > 0) Then
countFiles = 0
countSheets = 0
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Set wbkCurBook = ActiveWorkbook
For Each fnameCurFile In fnameList
countFiles = countFiles + 1
Set wbkSrcBook = Workbooks.Open(Filename:=fnameCurFile)
For Each wksCurSheet In wbkSrcBook.Sheets
countSheets = countSheets + 1
wksCurSheet.Copy After:=wbkCurBook.Sheets(wbkCurBook.Sheets.Count)
Next
wbkSrcBook.Close SaveChanges:=False
Next
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
MsgBox "Processed " & countFiles & " files" & vbCrLf & "Merged " & countSheets & " worksheets", Title:="Merge Excel files"
End If
Else
MsgBox "No files selected", Title:="Merge Excel files"
End If
End Sub
VBA Code:
' Below VBA sourced from...
' https://analysistabs.com/vba-code/excel-projects/append-data-from-multiple-worksheets-column/
Sub Append_Data_From_Different_Sheets_Into_Single_Sheet_By_Column()
'Procedure to Consolidate all sheets in a workbook
On Error GoTo IfError
'1. Variables declaration
Dim Sht As Worksheet, DstSht As Worksheet
Dim LstRow As Long, LstCol As Long, DstCol As Long
Dim i As Integer, EnRange As String
Dim SrcRng As Range
'2. Disable Screen Updating - stop screen flickering
' And Disable Events to avoid inturupted dialogs / popups
With Application
.ScreenUpdating = False
.EnableEvents = False
End With
'3. Delete the Append_Data WorkSheet if it exists
Application.DisplayAlerts = False
On Error Resume Next
ActiveWorkbook.Sheets("Append_Data").Delete
Application.DisplayAlerts = True
'4. Add a new WorkSheet and name as 'Append_Data'
With ActiveWorkbook
Set DstSht = .Sheets.Add(After:=.Sheets(.Sheets.Count))
DstSht.Name = "Append_Data"
End With
'5. Loop through each WorkSheet in the workbook and copy the data to the 'Append_Data' WorkSheet
For Each Sht In ActiveWorkbook.Worksheets
If Sht.Name <> DstSht.Name Then
'5.1: Find the last row on the 'Append_Data' sheet
DstCol = fn_LastColumn(DstSht)
If DstCol = 1 Then DstCol = 0
'5.2: Find Input data range
LstRow = fn_LastRow(Sht)
LstCol = fn_LastColumn(Sht)
EnRange = Sht.Cells(LstRow, LstCol).Address
Set SrcRng = Sht.Range("A1:" & EnRange)
'5.3: Check whether there are enough columns in the 'Append_Data' Worksheet
If DstCol + SrcRng.Columns.Count > DstSht.Columns.Count Then
MsgBox "There are not enough columns to place the data in the Append_Data worksheet."
GoTo IfError
End If
'5.4: Copy data to the 'Append_Data' WorkSheet
SrcRng.Copy Destination:=DstSht.Cells(2, DstCol + 1)
End If
Next
DstSht.Range("A1") = "You can place the heading in the first column"
IfError:
'6. Enable Screen Updating and Events
With Application
.ScreenUpdating = True
.EnableEvents = True
End With
End Sub
'In this example we are finding the last Row of specified Sheet
'In this example we are finding the last Row of specified Sheet
Function fn_LastRow(ByVal Sht As Worksheet)
Dim lastRow As Long
lastRow = Sht.Cells.SpecialCells(xlLastCell).Row
lRow = Sht.Cells.SpecialCells(xlLastCell).Row
Do While Application.CountA(Sht.Rows(lRow)) = 0 And lRow <> 1
lRow = lRow - 1
Loop
fn_LastRow = lRow
End Function
'In this example we are finding the last column of specified Sheet
Function fn_LastColumn(ByVal Sht As Worksheet)
Dim lastCol As Long
lastCol = Sht.Cells.SpecialCells(xlLastCell).Column
lCol = Sht.Cells.SpecialCells(xlLastCell).Column
Do While Application.CountA(Sht.Columns(lCol)) = 0 And lCol <> 1
lCol = lCol - 1
Loop
fn_LastColumn = lCol
End Function
VBA Code:
' VBA below sourced from...
' https://analysistabs.com/vba-code/excel-projects/consolidate-data-from-multiple-worksheets-row/
Sub Consolidate_Data_From_Different_Sheets_Into_Single_Sheet_by_Row()
'Procedure to Consolidate all sheets in a workbook
On Error GoTo IfError
'1. Variables declaration
Dim Sht As Worksheet, DstSht As Worksheet
Dim LstRow As Long, LstCol As Long, DstRow As Long
Dim i As Integer, EnRange As String
Dim SrcRng As Range
'2. Disable Screen Updating - stop screen flickering
' And Disable Events to avoid inturupted dialogs / popups
With Application
.ScreenUpdating = False
.EnableEvents = False
End With
'3. Delete the Consolidate_Data WorkSheet if it exists
Application.DisplayAlerts = False
On Error Resume Next
ActiveWorkbook.Sheets("Consolidate_Data").Delete
Application.DisplayAlerts = True
'4. Add a new WorkSheet and name as 'Consolidate_Data'
With ActiveWorkbook
Set DstSht = .Sheets.Add(After:=.Sheets(.Sheets.Count))
DstSht.Name = "Consolidate_Data"
End With
'5. Loop through each WorkSheet in the workbook and copy the data to the 'Consolidate_Data' WorkSheet
For Each Sht In ActiveWorkbook.Worksheets
If Sht.Name <> DstSht.Name Then
'5.1: Find the last row on the 'Consolidate_Data' sheet
DstRow = fn_LastRow(DstSht) + 1
'5.2: Find Input data range
LstRow = fn_LastRow(Sht)
LstCol = fn_LastColumn(Sht)
EnRange = Sht.Cells(LstRow, LstCol).Address
Set SrcRng = Sht.Range("A1:" & EnRange)
'5.3: Check whether there are enough rows in the 'Consolidate_Data' Worksheet
If DstRow + SrcRng.Rows.Count > DstSht.Rows.Count Then
MsgBox "There are not enough rows to place the data in the Consolidate_Data worksheet."
GoTo IfError
End If
'5.4: Copy data to the 'consolidated_data' WorkSheet
SrcRng.Copy Destination:=DstSht.Range("A" & DstRow)
End If
Next
IfError:
'6. Enable Screen Updating and Events
With Application
.ScreenUpdating = True
.EnableEvents = True
End With
End Sub
'In this example we are finding the last Row of specified Sheet
Function fn_LastRow(ByVal Sht As Worksheet)
Dim lastRow As Long
lastRow = Sht.Cells.SpecialCells(xlLastCell).Row
lRow = Sht.Cells.SpecialCells(xlLastCell).Row
Do While Application.CountA(Sht.Rows(lRow)) = 0 And lRow <> 1
lRow = lRow - 1
Loop
fn_LastRow = lRow
End Function
'In this example we are finding the last column of specified Sheet
Function fn_LastColumn(ByVal Sht As Worksheet)
Dim lastCol As Long
lastCol = Sht.Cells.SpecialCells(xlLastCell).Column
lCol = Sht.Cells.SpecialCells(xlLastCell).Column
Do While Application.CountA(Sht.Columns(lCol)) = 0 And lCol <> 1
lCol = lCol - 1
Loop
fn_LastColumn = lCol
End Function
) You were awesome. Thank you again.
