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

[icomefromchaos]

So far the code loops through all of the files, but only copies sheet 1 instead of making the combined sheet. It also creates hundreds of blank sheets in my new workbook that only has 1 combined tab that keeps looping the same information from the first file in my directory.

<code style="margin: 0px; padding: 0px; border: 0px; vertical-align: baseline; font-family: Consolas, Menlo, Monaco, 'Lucida Console', 'Liberation Mono', 'DejaVu Sans Mono', 'Bitstream Vera Sans Mono', 'Courier New', monospace, serif; white-space: inherit; background-image: initial; background-attachment: initial; background-size: initial; background-origin: initial; background-clip: initial; background-position: initial; background-repeat: initial;">Sub BatchProcessing()
MyPath = "C:\Users\USERNAME\Desktop\OCCREPORTS\Files\"
MyTemplate = "*.xls*"  ' Set the template.
MyName = Dir(MyPath & MyTemplate)    'Retrieve the first file
Do While MyName <> ""
    Workbooks.Open MyPath & MyName
    Combine                 'do your thing
    Workbooks(MyName).Close         'close
    MyName = Dir                    'Get next file
Loop
End Sub
Sub Combine()
Dim J As Integer
Dim s As Worksheet
Dim LastCol As Integer
    
       
    On Error Resume Next
    Sheets(1).Select
    Worksheets.Add ' add a sheet in first place
    Sheets(1).Name = "Combined"




For Each s In ActiveWorkbook.Sheets
        If s.Name <> "Combined" Then
            Application.Goto Sheets(s.Name).[A1]
            Selection.CurrentRegion.Select
            Sheet.UsedRange.Clear
            LastCol = Sheets("Combined").Cells(1, Columns.Count).End(xlToLeft).Column
            Selection.Copy Destination:=Sheets("Combined"). _
            Cells(1, LastCol + 1)
        End If
    Next
End Sub
</code>

The end Goal of this Macro is to copy all of the information that is in all of my workbooks, copy it to a tab that is called 'Combined' and then copy the 'Combined' sheet and then place it in my Target workbook. The Target workbook will house all of the information from 300 workbooks in one tab. For example, Workbook 1 has Sheet 1, sheet 2... sheets 40The selection of code below combines sheets 1...40 into a new sheet called 'Combined'

 'Selection.CurrentRegion.Select   
 'Sheet.UsedRange.Clear    
 'LastCol = Sheets("Combined").Cells(1, Columns.Count).End(xlToLeft).Column                    
 'Selection.Copy Destination:=Sheets("Combined"). _                              
 'Cells(1, LastCol + 1)From there I need to read the other workbooks, loop the code above and then paste the combined sheet into Sheet 1 of the Target workbook.

 

[RickXL]

Hi and welcome to the MrExcel Message Board.

Can I just clarify something?

Do you want to create a sheet called Combined in every workbook and save it or just in the one workbook.
And are the "master Excel" and "Target workbook" the same thing and is that the one with the macro?

First tip: If something is not working adding an On Error Resume Next is probably not the best idea because it will hide some problems. In your case it is hiding the fact that the

<code style="margin: 0px; padding: 0px; border: 0px; vertical-align: baseline; font-family: Consolas, Menlo, Monaco, 'Lucida Console', 'Liberation Mono', 'DejaVu Sans Mono', 'Bitstream Vera Sans Mono', 'Courier New', monospace, serif; white-space: inherit; background-image: initial; background-attachment: initial; background-size: initial; background-origin: initial; background-clip: initial; background-position: initial; background-repeat: initial;">
Sheet.UsedRange.Clear</code>

command is not working because it is not valid syntax.
It could be hiding some of the actions in the workbooks you are trying to read as well.
Are you saving those workbooks or exiting without saving?
If you are not saving then why create a Combined sheet in the data workbooks.
If you are saving then how are you preventing Excel from trying to create a second one? Or is that left to On Error Resume Next? In which case you willl just be left with an extra sheet.

Second Tip: When working with multiple workbooks I always Set the workbooks to an object variable then use that variable to make sure that the right workbook is being processed. If Excel finds a command that starts "Sheets(1)" how can you be sure which workbook it is looking at?

I tried out your macro on one of my test folders and it created a "Combined" worksheet in the first of the data workbooks. If the data was saved then the second time the macro was run it tried to create another Combined sheet. The second data workbook did not get a Combined sheet.

If you can just provide a bit more info I think we can get this working.

 

[icomefromchaos]

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?...kk&usp=sharing

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

 

[icomefromchaos]

https://drive.google.com/open?id=0B0m5F-NRHk_kTFRyb0JxYmo5Ykk&authuser=0

 

[RickXL]

What is it that you want it to do that it is not doing yet?

 

[icomefromchaos]

Requirement: when each new work book is opened, it appends the new 'Combined' sheet to the next row while keeping the formatting that it was copied from. Please look at the example data.
Example of how it should look: https://drive.google.com/folderview?id=0B0m5F-NRHk_kTFRyb0JxYmo5Ykk&usp=drive_web
If you look at the example data set. I have Example Target, and Example InCorrect Target. The Incorrect Target is the end product when I run the macro. However, instead of pasting the results in the next Column from Combined. I need it to keep the formatting from the Combined Tab, and paste the data in the next free row instead of column. This will allow my data to be represented in a massive table. Keeping my data uniform so I can upload it into a db.
If you look at Example Data 1 and Example Data 2 you will see the formatting of my data and tables. All of the tables follow the same formatting, so I want to be able to have all of my workbooks (3000+) to combined into one massive table where I can then upload the data into a db.

 

[icomefromchaos]

This was the original macro that I wrote that creates the combined tab:

  Sub Combine()
    Dim J As Integer
    Dim s As Worksheet
    Dim LastCol As Integer
    
       
    On Error Resume Next
    Sheets(1).Select
    Worksheets.Add ' add a sheet in first place
    Sheets(1).Name = "Combined"




For Each s In ActiveWorkbook.Sheets
        If s.Name <> "Combined" Then
            Application.Goto Sheets(s.Name).[A1]
            Selection.CurrentRegion.Select
            Sheet.UsedRange.Clear
            LastCol = Sheets("Combined").Cells(1, Columns.Count).End(xlToLeft).Column
            Selection.Copy Destination:=Sheets("Combined"). _
            Cells(1, LastCol + 1)
        End If
    Next
End Sub

But that only applies to one work book, and I needed to apply to hundreds of workbooks, and take the combined tab, and merged it into Target. In the Example Correct Target you'll see how the data should be formatted. In the Example Incorrect Target is how my data is being put together, by next column, while I need it to add the next sheet by row.
Here is the code:

Option Explicit


Sub MergeAllSheetsInAllWorkbooks()
Dim fPATH As String, fNAME As String, LastCol As Long, LastRow 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
LastRow = 1
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
    LastRow = Combined.Cells"A" & Rows.Count).End(xlUp).Row + 1
    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

 

[RickXL]

Hi again,

I think I have worked out what you are trying to do now.

You have a large number of workbooks with multiple sheets in each.
You want to copy the first worksheet in every workbook under each other in a new workbook.
You then want to repeat the process for all the second worksheets, this time pasting them alongside the first ones.
Repeat for all worksheets.
Save the resultant workbook on the desktop.

One problem I had was trying to work out how many types of workbooks you wanted to use. I have ended up with three: One with the macro, one which holds the temporary workings and is saved as the final output and a large set of data workbooks.

The tricky part was working out which row was the next blank one for any part of the process. I ended up writing a function that took a worksheet, start and end columns then returned the next completely unused row.

I suspect you won't be wanting all the header rows but I have not second-guessed that.
This is the macro so far.

Option Explicit

Sub MergeAllSheetsInAllWorkbooks()
    Dim fPATH As String, fNAME As String, NextCol As Long, NextRow As Long
    Dim wbC As Workbook, wb As Workbook, wsC As Worksheet, ws As Worksheet
    Dim nCols As Long
    
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    
    fPATH = ThisWorkbook.Path & "\Files\"
    Set wbC = Workbooks.Add
    Set wsC = wbC.Worksheets(1)
    wsC.Name = "Combined"
    
    NextCol = 1

    fNAME = Dir(fPATH & "*.xls")
    
    Do While Len(fNAME) > 0
        Set wb = Workbooks.Open(fPATH & fNAME)
        
        For Each ws In wb.Worksheets
            nCols = ws.Cells(1, ws.Columns.Count).End(xlToLeft).column
            ws.Range("A1").CurrentRegion.Copy wsC.Cells(NextEmptyRow(NextCol, NextCol + nCols - 1, wsC), NextCol)
            NextCol = NextCol + nCols
        Next ws
        
        NextCol = 1
        
        wb.Close False
        
        fNAME = Dir
    Loop
                                                                        
    wbC.SaveAs CreateObject("WScript.Shell").specialfolders("Desktop") & "\OCCREPORTS\Target.xlsx", 51
    wbC.Close
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
End Sub

Function NextEmptyRow(Col1 As Long, Optional Col2 As Long, Optional ws As Worksheet) As Long
    Dim r As Range
    If ws Is Nothing Then Set ws = ActiveSheet
    
    Set r = ws.Range(ws.Columns(Col1), ws.Columns(Col2))

    If WorksheetFunction.CountA(r) > 0 Then
        NextEmptyRow = r.Find( _
                            What:="*", _
                            After:=r.Cells(1, 1), _
                            SearchOrder:=xlByRows, _
                            SearchDirection:=xlPrevious).Row + 1
    Else
        NextEmptyRow = 1
    End If

End Function

I have tested it using your Excel files.

 

[icomefromchaos]

Hi again,

I think I have worked out what you are trying to do now.

You have a large number of workbooks with multiple sheets in each.
You want to copy the first worksheet in every workbook under each other in a new workbook.
You then want to repeat the process for all the second worksheets, this time pasting them alongside the first ones.
Repeat for all worksheets.
Save the resultant workbook on the desktop.

One problem I had was trying to work out how many types of workbooks you wanted to use. I have ended up with three: One with the macro, one which holds the temporary workings and is saved as the final output and a large set of data workbooks.

The tricky part was working out which row was the next blank one for any part of the process. I ended up writing a function that took a worksheet, start and end columns then returned the next completely unused row.

I suspect you won't be wanting all the header rows but I have not second-guessed that.
This is the macro so far.

Option Explicit

Sub MergeAllSheetsInAllWorkbooks()
    Dim fPATH As String, fNAME As String, NextCol As Long, NextRow As Long
    Dim wbC As Workbook, wb As Workbook, wsC As Worksheet, ws As Worksheet
    Dim nCols As Long
    
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    
    fPATH = ThisWorkbook.Path & "\Files\"
    Set wbC = Workbooks.Add
    Set wsC = wbC.Worksheets(1)
    wsC.Name = "Combined"
    
    NextCol = 1

    fNAME = Dir(fPATH & "*.xls")
    
    Do While Len(fNAME) > 0
        Set wb = Workbooks.Open(fPATH & fNAME)
        
        For Each ws In wb.Worksheets
            nCols = ws.Cells(1, ws.Columns.Count).End(xlToLeft).column
            ws.Range("A1").CurrentRegion.Copy wsC.Cells(NextEmptyRow(NextCol, NextCol + nCols - 1, wsC), NextCol)
            NextCol = NextCol + nCols
        Next ws
        
        NextCol = 1
        
        wb.Close False
        
        fNAME = Dir
    Loop
                                                                        
    wbC.SaveAs CreateObject("WScript.Shell").specialfolders("Desktop") & "\OCCREPORTS\Target.xlsx", 51
    wbC.Close
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
End Sub

Function NextEmptyRow(Col1 As Long, Optional Col2 As Long, Optional ws As Worksheet) As Long
    Dim r As Range
    If ws Is Nothing Then Set ws = ActiveSheet
    
    Set r = ws.Range(ws.Columns(Col1), ws.Columns(Col2))

    If WorksheetFunction.CountA(r) > 0 Then
        NextEmptyRow = r.Find( _
                            What:="*", _
                            After:=r.Cells(1, 1), _
                            SearchOrder:=xlByRows, _
                            SearchDirection:=xlPrevious).Row + 1
    Else
        NextEmptyRow = 1
    End If

End Function

I have tested it using your Excel files.

WOW!

Thank you very much! You we're correct. I will not require the headers.

You have saved me MASSIVE amounts of time. Is is possible for me to rank your profile or your answer. I'm not sure if this forum is points based, but you deserve all of them.

 

[icomefromchaos]

There seems to be a small error when I run it for all 3000 books. Pleas see the attached screenshot

https://drive.google.com/file/d/0B0m5F-NRHk_kZlVIVFVOUGlyZFk/view?usp=sharing

It seems that the rows are not aligning correctly. Maybe there needs to be a spaced row between each new insert of a new workbook.