aggregate sheets from many excel workbooks into one workbook

Question

I want to put the worksheets from several (2-5) excel workbooks (files) into one single workbook.

The names of the workbooks are not standardized and so I opted for a dialog box to select the workbooks.

Here is the code. It meets the basic requirement that all the worksheets (sheets actually) from the selected files are collected into a single file (the ActiveWorkbook).

Sub openDialogBoxAndSelectFiles()
 Dim wb1 As Workbook
 Set wb1 = ActiveWorkbook
 With Application.FileDialog(msoFileDialogFilePicker)
 .AllowMultiSelect = True
 .InitialFileName = ThisWorkbook.path & "\"
 .Title = "Paddington Bear Selection Window"
 .ButtonName = "Omlette"
 .Filters.Clear
 .Filters.Add "All Files", "*.*"
 If .Show = True Then
 Dim file As Variant
 For Each file In .SelectedItems
 Dim wb2 As Workbook
 Set wb2 = Workbooks.Open(Filename:=file, ReadOnly:=True)
 Dim i As Long
 For i = 1 To wb2.Sheets.Count
 wb2.Sheets(i).Copy before:=wb1.Sheets(1)
 Next i
 wb2.Close
 Next
 End If
 End With
End Sub

The code is pretty clean (I think) for the time being and pretty much fits the bill, but that's because it doesn't do the following:

If the ActiveWorkbook which I've defined as wb1 has blank sheets (and a wb has to have at least 1 sheet), once this process is done, I will have a few blank sheets left over.

So if file1.worksheets.count = 4, and file2.worksheets.count = 5, I will have a minimum of 10 (1 + 4 + 5) worksheets in the final workbook.

Questions:

1. Insofar as aggregating the sheets of the files is concerned, is this a reasonable way of doing it?
2. Is there a simple of ensuring there are no blank worksheets left over? Unless the input files have blank sheets that is.

Kindly,

Answer 1

I think the way you are doing this is reasonable. Regarding pre-existing blank sheets..The rewritten code below removes blank worksheet(s) in the importing workbook, after the selected workbooks' worksheets have been inserted.

Sub openDialogBoxAndSelectFiles()
 Dim wb1 As Workbook
 Set wb1 = ActiveWorkbook
 'Cache worksheet references
 Dim originalWorksheets As Collection
 Set originalWorksheets = New Collection
 For i = 1 To wb1.Sheets.Count
 originalWorksheets.Add wb1.Sheets(i)
 Next i
 With Application.FileDialog(msoFileDialogFilePicker)
 .AllowMultiSelect = True
 .InitialFileName = ThisWorkbook.Path & "\"
 .Title = "Paddington Bear Selection Window"
 .ButtonName = "Omlette"
 .Filters.Clear
 'only interested in Exel workbooks
 .Filters.Add "All Files", "*.xls*"
 If .Show = True Then
 For Each file In .SelectedItems
 ImportWorksheets wb1, file
 Next file
 End If
 End With
 'Delete non-imported blank worksheets
 If wb1.Sheets.Count > originalWorksheets.Count Then
 DeleteBlankSheets originalWorksheets
 End If
End Sub
Private Sub ImportWorksheets(ByRef wb1 As Workbook, ByVal filename As Variant)
On Error GoTo ErrorExit
 Dim wb2 As Workbook
 Set wb2 = Workbooks.Open(filename:=filename, ReadOnly:=True)
On Error GoTo WorkbookOpenError
 Dim i As Long
 For i = 1 To wb2.Sheets.Count
 wb2.Sheets(i).Copy before:=wb1.Sheets(1)
 Next i
WorkbookOpenError:
 wb2.Close
ErrorExit:
End Sub
Private Sub DeleteBlankSheets(ByRef originalWorksheets As Collection)
On Error GoTo ErrorExit
 Dim displayAlertsFlagCurrentValue As Boolean
 displayAlertsFlagCurrentValue = Application.DisplayAlerts
 'Prevent Sheet deletion prompts
 Application.DisplayAlerts = False
 Dim wksht As Worksheet
 For Each wksht In originalWorksheets
 If IsBlank(wksht) Then
 wksht.Delete
 End If
 Next wksht
ErrorExit:
 Application.DisplayAlerts = displayAlertsFlagCurrentValue
End Sub
Private Function IsBlank(ByRef wksht As Worksheet) As Boolean
 IsBlank = WorksheetFunction.CountA(wksht.UsedRange) = 0 And wksht.Shapes.Count = 0
End Function

• dactyrafficle: This would certainly solve the problem. I was considering something similar but it seemed kind of inelegant. I will keep this open for a bit longer, but it might just be the answer.
• dactyrafficle: In the end, the only thing I did differently is that I saved the original worksheet names as a collection, instead of the ws objects.
• BZngr: Perfectly good solution to use worksheet names in this context.