0

I have a macro that cycles through all the files you select. It collates the data across all the tabs (which match the master in terms of tab name) in that file then pastes it into a master file before moving to the next in the selection. (Having emptied out the master for new data.)

I need it to work on all files in a specific folder location rather than prompting the user to select the relevant files.

In this instance all these files are .xlsb and I need everything else the macro does to stay the same.

Sub Master_Merge()

'Speeds up the runtime and processing required when running the macro.
Application.DisplayAlerts = False
Application.Calculation = xlManual
Application.ScreenUpdating = False
Application.DisplayStatusBar = False
Application.AskToUpdateLinks = False
Application.EnableEvents = False

Dim LastRow As Long

'Deletes all of the existing data in every tab of the workbook.
ThisWorkbook.Worksheets("One").Rows("2:10000").EntireRow.Delete
ThisWorkbook.Worksheets("Two").Rows("2:10000").EntireRow.Delete
ThisWorkbook.Worksheets("Three").Rows("2:10000").EntireRow.Delete
ThisWorkbook.Worksheets("Four").Rows("2:10000").EntireRow.Delete
ThisWorkbook.Worksheets("Five").Rows("2:10000").EntireRow.Delete

    'Opens up File Explorer so that all relevant files can be selected.
    Set TargetFiles = Application.FileDialog(msoFileDialogOpen)
    With TargetFiles
        .AllowMultiSelect = True
        .Title = "Select all relevant files."
        .ButtonName = ""
        .Filters.Clear
        .Filters.Add ".xls* files", "*.xls*"
        .Show
    End With
    
    'Loop through all files.
    For FileIdx = 1 To TargetFiles.SelectedItems.Count

        'Opens all selected files.
        Set Databook = Workbooks.Open(TargetFiles.SelectedItems(FileIdx))

'---------------------------------------------------------------------------------------------------------

                'Turns the table off so the data can be interacted with easier.
                Databook.Worksheets("One").Activate
                       
                    'Find last row on the relevant worksheet.
                    LastRow = ActiveSheet.Cells(Rows.Count, 2).End(xlUp).Row
                       
                'Copies the relevant data from the specified section.
                ActiveSheet.Range("B2:U" & LastRow).Copy
                
                'Pastes it into the relevant area in the Database file.
                Workbooks("Master Merge File").Sheets("One").Activate
                Range("A10000").End(xlUp).Offset(1, 0).Activate
                
                'Increase the 100000 above if your data is more than 100000 rows.
                Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
                :=False, Transpose:=False
                Application.CutCopyMode = False

    'Clears the clipboard at the end of each workbook being copied.
    Application.CutCopyMode = False

'---------------------------------------------------------------------------------------------------------

                'Turns the table off so the data can be interacted with easier.
                Databook.Worksheets("Two").Activate
                       
                    'Find last row on the relevant worksheet.
                    LastRow = ActiveSheet.Cells(Rows.Count, 2).End(xlUp).Row
                       
                'Copies the relevant data from the specified section.
                ActiveSheet.Range("B2:W" & LastRow).Copy
                
                'Pastes it into the relevant area in the Database file.
                Workbooks("Master Merge File").Sheets("Two").Activate
                Range("A10000").End(xlUp).Offset(1, 0).Activate
                
                'Increase the 100000 above if your data is more than 100000 rows.
                Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
                :=False, Transpose:=False
                Application.CutCopyMode = False
    
    'Clears the clipboard at the end of each workbook being copied.
    Application.CutCopyMode = False

'---------------------------------------------------------------------------------------------------------

                'Turns the table off so the data can be interacted with easier.
                Databook.Worksheets("Three").Activate
                       
                    'Find last row on the relevant worksheet.
                    LastRow = ActiveSheet.Cells(Rows.Count, 2).End(xlUp).Row
                       
                'Copies the relevant data from the specified section.
                ActiveSheet.Range("B2:W" & LastRow).Copy
                
                'Pastes it into the relevant area in the Database file.
                Workbooks("Master Merge File").Sheets("Three").Activate
                Range("A10000").End(xlUp).Offset(1, 0).Activate
                
                'Increase the 100000 above if your data is more than 100000 rows.
                Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
                :=False, Transpose:=False
                Application.CutCopyMode = False
    
    'Clears the clipboard at the end of each workbook being copied.
    Application.CutCopyMode = False

'---------------------------------------------------------------------------------------------------------

                'Turns the table off so the data can be interacted with easier.
                Databook.Worksheets("Four").Activate
                       
                    'Find last row on the relevant worksheet.
                    LastRow = ActiveSheet.Cells(Rows.Count, 2).End(xlUp).Row
                       
                'Copies the relevant data from the specified section.
                ActiveSheet.Range("B2:Q" & LastRow).Copy
                
                'Pastes it into the relevant area in the Database file.
                Workbooks("Master Merge File").Sheets("Four").Activate
                Range("A10000").End(xlUp).Offset(1, 0).Activate
                
                'Increase the 100000 above if your data is more than 100000 rows.
                Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
                :=False, Transpose:=False
                Application.CutCopyMode = False
    
    'Clears the clipboard at the end of each workbook being copied.
    Application.CutCopyMode = False

'---------------------------------------------------------------------------------------------------------

                'Turns the table off so the data can be interacted with easier.
                Databook.Worksheets("Five").Activate
                       
                    'Find last row on the relevant worksheet.
                    LastRow = ActiveSheet.Cells(Rows.Count, 2).End(xlUp).Row
                       
                'Copies the relevant data from the specified section.
                ActiveSheet.Range("B2:Q" & LastRow).Copy
                
                'Pastes it into the relevant area in the Database file.
                Workbooks("Master Merge File").Sheets("Five").Activate
                Range("A10000").End(xlUp).Offset(1, 0).Activate
                
                'Increase the 100000 above if your data is more than 100000 rows.
                Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
                :=False, Transpose:=False
                Application.CutCopyMode = False

            'Closes the current workbook and moves onto the next one which has been selected
            Databook.Close False
    
    'Clears the clipboard at the end of each workbook being copied.
    Application.CutCopyMode = False

'---------------------------------------------------------------------------------------------------------

Next

'Sets alerts and updates back on otherwise functionality is compromised.
Application.DisplayAlerts = True
Application.Calculation = xlAutomatic
Application.ScreenUpdating = True
Application.DisplayStatusBar = True
Application.AskToUpdateLinks = True
Application.EnableEvents = True

End Sub

Based on a link provided I changed:

'Opens up File Explorer so that all relevant files can be selected.
Set TargetFiles = Application.FileDialog(msoFileDialogOpen)
With TargetFiles
    .AllowMultiSelect = True
    .Title = "Select all relevant files."
    .ButtonName = ""
    .Filters.Clear
    .Filters.Add ".xls* files", "*.xls*"
    .Show
End With

'Loop through all files.
For FileIdx = 1 To TargetFiles.SelectedItems.Count

    'Opens all selected files.
    Set Databook = Workbooks.Open(TargetFiles.SelectedItems(FileIdx))

To:

Dim StrFile As String
TargetFiles = Dir("C:\Users\me\Folder\*.xlsb")
Do While Len(StrFile) > 0

and then adjusted the end so instead of the "Next" we have:

    TargetFiles = Dir
Loop

This changed code runs with no errors, deletes out all the old data and collates absolutely nothing.

Community
  • 1
  • 1
Kovu
  • 35
  • 6
  • 1
    https://stackoverflow.com/questions/10380312/loop-through-files-in-a-folder-using-vba – BigBen Sep 28 '22 at 14:08
  • I did see the post on the link provided but couldn't figure out how to implement it with my code, seemed like it has issues with "Dir". Also whilst I get which part of my code is prompting the selection of files I'm unsure what to cut to get the new code to work. – Kovu Sep 28 '22 at 14:12
  • 1
    Please show us your attempt to integrate your code with the code in the link – cybernetic.nomad Sep 28 '22 at 15:46
  • I've edited the original post to include a response to your request at the end. As there is a character limit in comments. Appreciate if you know what to tweak to get it working! – Kovu Sep 29 '22 at 09:47
  • Seems like this has gone dead, would be useful if i could get some help? – Kovu Oct 07 '22 at 10:11

0 Answers0