Results 1 to 9 of 9
  1. #1
    New Lounger
    Join Date
    Nov 2014
    Posts
    1
    Thanks
    0
    Thanked 0 Times in 0 Posts

    Applying macro across 300 workbooks; copying results into master Excel file

    I wrote a macro that combines the information from 3 different sheets and places it in a new sheet called 'Combined'. However, I have to apply this macro to over 300 books, and I dont want to open each book, apply the macro, and then copy and paste the new 'Combined' sheet into a file called 'Finished'

    My end Goal, is to have the 'Combined' sheet created in each workbook, and then copy that text into a new workbook that holds all of the 'Combined' in one tab, that starts on the next empty row.

    The DoWork part that combines all of the sheets combines all of the sheets by the next COLUMN. This is important because each of the sheets are tables of data, and I need the headers to remain in row 1. However, after the combined process is done. in the Finished workbook needs to append the data on the next row, to keep the tables consistent. This later will be uploaded into an SQL DB.


    Code:
    Sub ProcessFiles()
    Dim Filename, Pathname As String
    Dim wb As Workbook
    
    Pathname = ActiveWorkbook.Path & "\Files\"
    Filename = Dir(Pathname & "*.xls")
    Do While Filename <> ""
        Set wb = Workbooks.Open(Pathname & Filename)
        DoWork wb
        wb.Close SaveChanges:=True
        Filename = Dir()
    Loop
    End Sub
    Sub DoWork(wb As Workbook)
        With wb
            Dim J As Integer
            Dim s As Worksheet
            Dim NextEmptyCol As Long
            Dim Sheet As Worksheet
    
    
            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(Columns.Count, 1).End(xlUp)(2)
                    ThisWorkbook.Sheets("Combined").Copy
                    Application.Goto Sheets(s.Name).[A1]
                    Selection.CurrentRegion.Select
                    Sheet.UsedRange.Clear
                    Selection.Copy Destination:=Sheets("Combined"). _
                    Cells(Rows.Count, 1).End(xlUp)(2)
                    ActiveWorkbook.SaveAs "C:\Users\CHANGED_USERNAME\Desktop\OCCREPORTS\Target.xlsx", FileFormat:=51
                End If
            Next
        End With
    End Sub
    ERROR:
    HTML Code:
    Select Method of Worksheet class failed
    I have made some changes... I'm still not understanding what I am doing incorrectly. This is my first VBA that I've written so, I apologize for any spaghetti code.
    Last edited by icomefromchoas; 2014-11-20 at 13:05.

  2. #2
    Super Moderator RetiredGeek's Avatar
    Join Date
    Mar 2004
    Location
    Manning, South Carolina
    Posts
    9,434
    Thanks
    372
    Thanked 1,457 Times in 1,326 Posts
    Chaos,

    Welcome to the Lounge as a new poster!

    I've tried to clean up your code some but I'm not sure exactly what you are trying to accomplish by some of the statements. I've commented out these statements as a way to identify them and allow you to add comments telling us what you want them to do.

    You'll notice that I've messed with some of your variable definitions, this is an attempt to make the code easier to read by making the names more meaningful (at least to me).

    You used Sheet as an object variable name which is not a good idea because it is easily confused with the builtin object name for sheets. You also failed to initialize (Set) this variable so I don't know what you want it to refer to.

    Here's the code as I've changed it so far. If you would add comments on what each of the lines should do and what workbook/worksheet it is working on this would be most helpful. Of course a Workbook or 2 with sample data would be even better!

    Code:
    Sub ProcessFiles()
    
       Dim zFileName  As String
       Dim zPathName  As String
       Dim wkbWorking As Workbook
    
       zPathName = ActiveWorkbook.Path & "\Files\"
       zFileName = Dir(zPathName & "*.xls")
    
       Do While zFileName <> ""
         Set wkbWorking = Workbooks.Open(zPathName & zFileName)
         DoWork wkbWorking
         wkbWorking.Close SaveChanges:=True
         zFileName = Dir()
       Loop
    
    End Sub
    
    Sub DoWork(wkbWorking As Workbook)
    
       Dim lLastCol     As Long
       Dim NextEmptyCol As Long
       Dim wksCur       As Worksheet
       Dim wksComb      As Worksheet
    
        With wkbWorking
    
            .Sheets(1).Select
            Set wksComb = Worksheets.Add
            wksComb.Name = "Combined"
    
            For Each wksCur In wkbWorking.Sheets
    
                If wksCur.Name <> "Combined" Then
                    Application.Goto wksCur.[A1]
                    Selection.CurrentRegion.Select
    '               Sheet.UsedRange.Clear
                    lLastCol = wksComb.Cells(1, Columns.Count).End(xlToLeft).Column
    '                Selection.Copy Destination:=wksComb. _
    '                          Cells(Columns.Count, 1).End(xlUp)(2)
                    wksComb.Copy
                    Application.Goto wksCur.[A1]
                    Selection.CurrentRegion.Select
                    Sheet.UsedRange.Clear
                    Selection.Copy Destination:=Sheets("Combined"). _
                    Cells(Rows.Count, 1).End(xlUp)(2)
                    ActiveWorkbook.SaveAs "C:\Users\CHANGED_USERNAME\Desktop\OCCREPORTS\Target.xlsx", FileFormat:=51
                End If
    
            Next          'wksCur
    
        End With          'wkbWorking
    
    End Sub
    HTH
    May the Forces of good computing be with you!

    RG

    PowerShell & VBA Rule!

    My Systems: Desktop Specs
    Laptop Specs

  3. #3
    New Lounger
    Join Date
    Nov 2014
    Posts
    5
    Thanks
    0
    Thanked 0 Times in 0 Posts

    Changes made to code.. New username also

    Code:
    'The Sub function reads all 300 workbooks that need to have the DoWork function executed 
    Sub Batch()
    Dim wb As Workbook, MyPath, MyTemplate, MyName
    Dim Filename, Pathname As String
    
    Pathname = ActiveWorkbook.Path & "\Files\" 								' Reads in directory that contains files that need to be edited by DoWork
    Filename = Dir(Pathname & "*.xls")
    Do While Filename <> "" 
        Set wb = Workbooks.Open(Pathname & Filename) 						' Opens files in "Files" 
        DoWork wb 															' Executes function DoWork
        wb.Close SaveChanges:=True 											' closes and saves changes 
        Filename = Dir()
    	
    Loop 																	' loops 
    End Sub																	' What this Sub Batch() does not do properly... It opens the Target workbook, but it does not copy and save the Combined tab from the other workbooks.	
    Sub DoWork(wb As Workbook) 							' Beginning of DoWork: this function merges all of the sheets that are contained in a workbooks into one sheet and then TRIES to copy the information from the new 'Combined' sheet into Target workbook Sheet 1
        With wb 
            Dim J As Integer
            Dim s As Worksheet
            Dim NextEmptyCol As Long
    
        On Error Resume Next							' If error ties to go to next tab
        Sheets(1).Select 								' Selects sheet
        Worksheets.Add ' add a sheet in first place		' Adds a new sheet 
        Sheets(1).Name = "Combined"						' Renames Sheet 1 and calls it "Combined"
    
    For Each s In ActiveWorkbook.Sheets					' Begins For Loop for all active workbooks
            If s.Name <> "Combined" Then 				' If the Sheet "Combined was created continues
                Application.Goto Sheets(s.Name).[A1]	' Starts reading at A1
                Selection.CurrentRegion.Select
                Sheet.UsedRange.Clear
                LastCol = Sheets("Combined").Cells(1, Columns.Count).End(xlToLeft).Column 					 ' finds all columns in use
                Selection.Copy Destination:=Sheets("Combined"). _ 											 ' copies all columns 
                Cells(1, LastCol + 1) 																		 ' Adds all copied columns  from sheets 1-N to "Combined" sheet where all copied information is contained in a table like format.
                ThisWorkbook.Sheets("Combined").Copy														 ' Here and below.... I am trying to copy all of the information that was opened in my original workbook and combine it my Final workbook called 'Target' in Sheet 1
                Application.Goto Sheets(s.Name).[A1]
                Selection.CurrentRegion.Select
                Sheet.UsedRange.Clear
                ActiveWorkbook.SaveAs "C:\Users\username\Desktop\OCCREPORTS\Target.xlsx", FileFormat:=51 	' Saves information that was pulled from the Combined tab and saves it in my Target .... I also changed username... 
           End If
        Next
    End With
    End Sub
    
    
    ' *Notes 1*
    ' 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 40
    '  The 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)
    -------
    'After this has taken place, I want to have the information from Combined saved into a new workbook in sheet called Sheet 1
    'and then loop through all 300 workbooks, making the combine tab, coping the combine tab, and then saving it into target in the next free ROW.
    	'Saving in the next free row will allow my data to remain uniform. 
    	
    -------
    ' *Notes 2*
    ' Here is the code that I used to to test to make sure that my DoWork function is actually creating the Combined sheet and copying my information over correctly... 
    ' I've tried to create the Sub Batch() around this part...
    	'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
    
    ----- 
    ' *Notes 3*
    ' So basically apply the function in Note 2 across all 300 of my workbooks and then copying the 'Combined' sheets from all 300 books and paste it all into one Sheet in Workbook Target.
    
    ' ** Thank you for your help; I've invested quite a bit of time into this, and I hope my documentation has helped you understand what I'm trying to accomplish.

  4. #4
    New Lounger
    Join Date
    Nov 2014
    Posts
    5
    Thanks
    0
    Thanked 0 Times in 0 Posts

    Update on executing program

    Quote Originally Posted by icomefromchaos View Post
    Code:
    'The Sub function reads all 300 workbooks that need to have the DoWork function executed 
    Sub Batch()
    Dim wb As Workbook, MyPath, MyTemplate, MyName
    Dim Filename, Pathname As String
    
    Pathname = ActiveWorkbook.Path & "\Files\" 								' Reads in directory that contains files that need to be edited by DoWork
    Filename = Dir(Pathname & "*.xls")
    Do While Filename <> "" 
        Set wb = Workbooks.Open(Pathname & Filename) 						' Opens files in "Files" 
        DoWork wb 															' Executes function DoWork
        wb.Close SaveChanges:=True 											' closes and saves changes 
        Filename = Dir()
    	
    Loop 																	' loops 
    End Sub																	' What this Sub Batch() does not do properly... It opens the Target workbook, but it does not copy and save the Combined tab from the other workbooks.	
    Sub DoWork(wb As Workbook) 							' Beginning of DoWork: this function merges all of the sheets that are contained in a workbooks into one sheet and then TRIES to copy the information from the new 'Combined' sheet into Target workbook Sheet 1
        With wb 
            Dim J As Integer
            Dim s As Worksheet
            Dim NextEmptyCol As Long
    
        On Error Resume Next							' If error ties to go to next tab
        Sheets(1).Select 								' Selects sheet
        Worksheets.Add ' add a sheet in first place		' Adds a new sheet 
        Sheets(1).Name = "Combined"						' Renames Sheet 1 and calls it "Combined"
    
    For Each s In ActiveWorkbook.Sheets					' Begins For Loop for all active workbooks
            If s.Name <> "Combined" Then 				' If the Sheet "Combined was created continues
                Application.Goto Sheets(s.Name).[A1]	' Starts reading at A1
                Selection.CurrentRegion.Select
                Sheet.UsedRange.Clear
                LastCol = Sheets("Combined").Cells(1, Columns.Count).End(xlToLeft).Column 					 ' finds all columns in use
                Selection.Copy Destination:=Sheets("Combined"). _ 											 ' copies all columns 
                Cells(1, LastCol + 1) 																		 ' Adds all copied columns  from sheets 1-N to "Combined" sheet where all copied information is contained in a table like format.
                ThisWorkbook.Sheets("Combined").Copy														 ' Here and below.... I am trying to copy all of the information that was opened in my original workbook and combine it my Final workbook called 'Target' in Sheet 1
                Application.Goto Sheets(s.Name).[A1]
                Selection.CurrentRegion.Select
                Sheet.UsedRange.Clear
                ActiveWorkbook.SaveAs "C:\Users\username\Desktop\OCCREPORTS\Target.xlsx", FileFormat:=51 	' Saves information that was pulled from the Combined tab and saves it in my Target .... I also changed username... 
           End If
        Next
    End With
    End Sub
    
    
    ' *Notes 1*
    ' 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 40
    '  The 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)
    -------
    'After this has taken place, I want to have the information from Combined saved into a new workbook in sheet called Sheet 1
    'and then loop through all 300 workbooks, making the combine tab, coping the combine tab, and then saving it into target in the next free ROW.
    	'Saving in the next free row will allow my data to remain uniform. 
    	
    -------
    ' *Notes 2*
    ' Here is the code that I used to to test to make sure that my DoWork function is actually creating the Combined sheet and copying my information over correctly... 
    ' I've tried to create the Sub Batch() around this part...
    	'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
    
    ----- 
    ' *Notes 3*
    ' So basically apply the function in Note 2 across all 300 of my workbooks and then copying the 'Combined' sheets from all 300 books and paste it all into one Sheet in Workbook Target.
    
    ' ** Thank you for your help; I've invested quite a bit of time into this, and I hope my documentation has helped you understand what I'm trying to accomplish.
    Right now, the code opens Target workbook, copies my sheets VINCases, VINdata , Data, ... but does not Combine the sheets. Then after running through 1 workbook, it closes the previous, but then loops through creating blank sheets Sheet1, sheet2, sheet3... etc. until the macro loops through all of the workbooks in my \Files\ folder.

  5. #5
    New Lounger
    Join Date
    Nov 2014
    Posts
    5
    Thanks
    0
    Thanked 0 Times in 0 Posts

    MoreChanges

    Code:
    Sub BatchProcessing()
    MyPath = "C:\Users\USER\Desktop\OCCREPORTS\Files\"
    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
    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

  6. #6
    Super Moderator RetiredGeek's Avatar
    Join Date
    Mar 2004
    Location
    Manning, South Carolina
    Posts
    9,434
    Thanks
    372
    Thanked 1,457 Times in 1,326 Posts
    Chaos,

    Still waiting for the sample data workbooks.
    May the Forces of good computing be with you!

    RG

    PowerShell & VBA Rule!

    My Systems: Desktop Specs
    Laptop Specs

  7. #7
    New Lounger
    Join Date
    Nov 2014
    Posts
    5
    Thanks
    0
    Thanked 0 Times in 0 Posts

    sample data

    Quote Originally Posted by RetiredGeek View Post
    Chaos,

    Still waiting for the sample data workbooks.




    I had to remove the actual data due to privacy issues. But the tables remain static through all 300 workbooks. So in the example that I sent you, all data is merged into the newly created combined sheet where the data is copied to the empty column, and then copied and pasted into a new workbook, this information is pasted in the next free row. Allowing my data to remain uniform for so i can upload it into an SQL db.
    Attached Files Attached Files

  8. #8
    New Lounger
    Join Date
    Nov 2014
    Posts
    5
    Thanks
    0
    Thanked 0 Times in 0 Posts
    I am getting closer... I rewrote it again... 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/open?id=0B0...Ykk&authuser=0

    Code:
    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

  9. #9
    New Lounger
    Join Date
    Oct 2011
    Location
    Warrington, PA
    Posts
    10
    Thanks
    3
    Thanked 1 Time in 1 Post
    Can't macros be written into a file and included as an Add-In?

Tags for this Thread

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •