Merge all workbooks with all sheets from folder

Question

I have downloaded a macro which works well, but I would like to merge all workbook sheets. This macro gets just the first worksheet:

Sub MergeAllWorkbooks()
Dim SummarySheet As Worksheet
Dim FolderPath As String
Dim NRow As Long
Dim FileName As String
Dim WorkBk As Workbook
Dim SourceRange As Range
Dim DestRange As Range

Application.DisplayAlerts = False
Application.ScreenUpdating = False


' Create a new workbook and set a variable to the first sheet.
'Set SummarySheet = Workbooks.Add(xlWBATWorksheet).Worksheets(1)

Set SummarySheet = ThisWorkbook.Sheets.Add
SummarySheet.Name = "ALL"

'Clear all old data
SummarySheet.Cells.Delete

' Modify this folder path to point to the files you want to use.
FolderPath = "C:\excel\"

' NRow keeps track of where to insert new rows in the destination workbook.
NRow = 1

' Call Dir the first time, pointing it to all Excel files in the folder path.
FileName = Dir(FolderPath & "*.xl*")

' Loop until Dir returns an empty string.
Do While FileName <> ""
    ' Open a workbook in the folder
    Set WorkBk = Workbooks.Open(FolderPath & FileName)

    ' Set the cell in column A to be the file name.
    SummarySheet.Range("A" & NRow).Value = FileName

    ' Set the source range to be A9 through C9.
    ' Modify this range for your workbooks.
    ' It can span multiple rows.
    Dim LastRow As Long
     LastRow = WorkBk.Worksheets(1).Cells.Find(What:="*", _
             After:=WorkBk.Worksheets(1).Cells.Range("A1"), _
             SearchDirection:=xlPrevious, _
             LookIn:=xlFormulas, _
             SearchOrder:=xlByRows).Row

    Set SourceRange = WorkBk.Worksheets(1).Range("A1:AA" & LastRow1)

    ' Set the destination range to start at column B and
    ' be the same size as the source range.
    Set DestRange = SummarySheet.Range("B" & NRow)
    Set DestRange = DestRange.Resize(SourceRange.Rows.Count, SourceRange.Columns.Count)

    ' Copy over the values from the source to the destination.
    DestRange.Value = SourceRange.Value

    SourceRange.Copy
    DestRange.PasteSpecial (xlPasteFormats)
    Application.CutCopyMode = False



    ' Increase NRow so that we know where to copy data next.
    NRow = NRow + DestRange.Rows.Count

    ' Close the source workbook without saving changes.
    WorkBk.Close savechanges:=False

    ' Use Dir to get the next file name.
    FileName = Dir()
Loop

Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub  

In my .xl* files, there is a variable number of sheets (sometimes one, sometimes six).

Can you help me with looping every sheet in opened workbook?

Answer 1

Well the easiest way would be to save every worksheet as a separate workbook. That would require very minimal effort as long as the number of workbooks is limited.

An other solution would be to build a FOR loop for . That would start after:

' Open a workbook in the folder
Set WorkBk = Workbooks.Open(FolderPath & FileName)

And would be something like:

Dim L As Long
L = ThisWorkbook.Worksheets.Count
For Worksheets 1 to L

And then insert a NEXT after

' Increase NRow so that we know where to copy data next.
NRow = NRow + DestRange.Rows.Count

I am no real expert at this, but I've been doing similar things for the past few weeks, so let me know if it was any help or not.

Answer 2

I'd say user148116 is very close. But a couple of changes from there.

Set up the loop like this

Dim L As Long
For L = 1 To WorkBk.Worksheets.Count

also replace the 1's with L's eg

Set SourceRange = WorkBk.Worksheets(L).Range("A1:AA" & LastRow1)

(ps shouldn't LastRow1 be LastRow?)

End result (for the inner loop) something like the below:

' Loop until Dir returns an empty string.
Do While Filename <> ""
    ' Open a workbook in the folder
    Set WorkBk = Workbooks.Open(FolderPath & Filename)

    Dim L As Long
    For L = 1 To WorkBk.Worksheets.Count

        ' Set the cell in column A to be the file name.
        SummarySheet.Range("A" & NRow).Value = Filename

        ' Set the source range to be A9 through C9.
        ' Modify this range for your workbooks.
        ' It can span multiple rows.
        Dim LastRow As Long
         LastRow = WorkBk.Worksheets(L).Cells.Find(What:="*", _
                 After:=WorkBk.Worksheets(L).Cells.Range("A1"), _
                 SearchDirection:=xlPrevious, _
                 LookIn:=xlFormulas, _
                 SearchOrder:=xlByRows).Row

        Set SourceRange = WorkBk.Worksheets(L).Range("A1:AA" & LastRow1)

        ' Set the destination range to start at column B and
        ' be the same size as the source range.
        Set DestRange = SummarySheet.Range("B" & NRow)
        Set DestRange = DestRange.Resize(SourceRange.Rows.Count, SourceRange.Columns.Count)

        ' Copy over the values from the source to the destination.
        DestRange.Value = SourceRange.Value

        SourceRange.Copy
        DestRange.PasteSpecial (xlPasteFormats)
        Application.CutCopyMode = False

        ' Increase NRow so that we know where to copy data next.
        NRow = NRow + DestRange.Rows.Count

    Next L

    ' Close the source workbook without saving changes.
    WorkBk.Close savechanges:=False

    ' Use Dir to get the next file name.
    Filename = Dir()
Loop