CODEWITHSUNDEEP
vbaexcel
icomefromchaos
icomefromchaos

Reputation: 39

Apply a macro across a hundred workbooks, and then copying the results into a master Excel file

I rewrote it... This is a little better, but its not quite doing what I want... Here is some sample data with the an example of the finished product.

Sample data: https://drive.google.com/folderview?id=0B0m5F-NRHk_kTFRyb0JxYmo5Ykk&usp=drive_web

Option Explicit

Sub MergeAllSheetsInAllWorkbooks()
Dim fPATH As String, fNAME As String, LastCol As Long
Dim wb As Workbook, ws As Worksheet, Combined As Worksheet

Application.ScreenUpdating = False                                  'speed up macro execution
Application.DisplayAlerts = False                                   'take default answer for all error alerts

fPATH = ThisWorkbook.Path & "\Files\"                               'path to data files, possibly use ActiveWorkbook

Sheets.Add                                                          'create the new sheet
ActiveSheet.Move                                                    'move to new workbook
Set Combined = ActiveSheet                                          'set anchor to new sheet
Combined.Name = "Combined"                                          'set the name

LastCol = 1                                                         'starting column for new output
fNAME = Dir(fPATH & "*.xls")                                        'get first filename

Do While Len(fNAME) > 0                                             'loop one file at a time
    Set wb = Workbooks.Open(fPATH & fNAME)                          'open the found file
    For Each ws In wb.Worksheets                                    'cycle through all the sheets in the wb
        ws.Range("A1").CurrentRegion.Copy Combined.Cells(1, LastCol)        'copy to COMBINED sheet
        LastCol = Combined.Cells(1, Columns.Count).End(xlToLeft).Column + 1 'set next target column
    Next ws
    wb.Close False                                                  'close the found file

    fNAME = Dir                                                     'get the next filename
Loop
                                                                    'save the results
Combined.Parent.SaveAs "C:\Users\username\Desktop\OCCREPORTS\Target.xlsx", 51
Application.ScreenUpdating = True                                   'update screen all at once 

End Sub

Upvotes: 1

Views: 142

Answers (1)

AtAFork
AtAFork

Reputation: 376

Try reordering the bottom of the DoWork sub, because End If should come first, then Next, and then finally End With

Instead of this:

        End With
    End If
Next

do:

        End If
    Next
End With

Upvotes: 3

Related Questions