CODEWITHSUNDEEP
vbaexcel
vfalki
vfalki

Reputation: 11

Copying worksheets from multiple workbooks into current workbook when some workbooks have one sheet, some have many, some have hidden worksheets

As the title says, I am attempting to copy all visible worksheets from a set of workbooks into a single workbook.

All of the workbooks are always in the same directory, but they will vary in file name. I had tried originally using the code below, but I'm running into issues where the 'Next Sheet' line attempts to go to the next sheet in the workbook its copying from, even if there are no more worksheets.

More specifically, my underlying workbooks which I'm trying to combine have a varying number of worksheets; some have one, some have many, and some have many with hidden worksheets too. I am only trying to copy sheets that are visible, and need to be able to handle the situation where a workbook could have one or many sheets.

I had tried a variant of the code below where I would count sheets and go to a separate code if there was one or more than one sheet, but that wasn't working either. Any help is much appreciated, and thank you all for your time.

Sub ConslidateWorkbooks()

Dim FolderPath As String
Dim Filename As String
Dim Sheet As Worksheet
Application.ScreenUpdating = False
FolderPath = "MyPath"
Filename = Dir(FolderPath & "*.xls*")
Do While Filename <> ""
 Workbooks.Open Filename:=FolderPath & Filename
 For Each Sheet In ActiveWorkbook.Sheets
 Sheet.Copy after:=ThisWorkbook.Sheets(1)
 Next Sheet
 Workbooks(Filename).Close
 Filename = Dir()
Loop
Application.ScreenUpdating = True
End Sub

Upvotes: 1

Views: 786

Answers (2)

ERT
ERT

Reputation: 729

Try something along these lines:

Sub ConslidateWorkbooks()
'Code to pull sheets from multiple Excel files in one file directory
'into master "Consolidation" sheet.

Dim FolderPath As String
Dim Filename As String
Dim Sheet As Worksheet

With ActiveSheet
    Range("A1").Activate
End With

Application.ScreenUpdating = False
FolderPath = ActiveWorkbook.Path & "\"
Filename = Dir(FolderPath & "*.xls*")

Do While Filename <> ""
   Workbooks.Open Filename:=FolderPath & Filename, ReadOnly:=True
   For Each Sheet In ActiveWorkbook.Sheets
   If Sheet.Visible = TRUE Then
       copyOrRefreshSheet ThisWorkbook, Sheet
   End If
   Next Sheet
   Workbooks(Filename).Close
   Filename = Dir()
Loop

Application.ScreenUpdating = True

End Sub



Sub copyOrRefreshSheet(destWb As Workbook, sourceWs As Worksheet)
  Dim ws As Worksheet
  On Error Resume Next
  Set ws = destWb.Worksheets(sourceWs.Name)
  On Error GoTo 0
  If ws Is Nothing Then
    sourceWs.Copy After:=destWb.Worksheets(destWb.Worksheets.Count)
  Else
    ws.Cells.ClearContents
    ws.Range(sourceWs.UsedRange.Address).Value = sourceWs.UsedRange.Value2
  End If
End Sub

Upvotes: 0

YowE3K
YowE3K

Reputation: 23974

You should assign an object reference to the workbooks you open, rather than relying on ActiveWorkbook:

Dim wb As Workbook
Do While Filename <> ""
    Set wb = Workbooks.Open(Filename:=FolderPath & Filename)
    For Each Sheet In wb.Sheets
        If Sheet.Visible = xlSheetVisible Then 'only copy visible sheets
            Sheet.Copy After:=ThisWorkbook.Sheets(1)
        End If
    Next Sheet
    wb.Close
    Filename = Dir()
Loop

By avoiding the use of ActiveWorkbook, you will get around issues raised by users doing things that your code is not expecting.

Upvotes: 1

Related Questions