Looping through files in a given folder and copying and pasting spreadsheet data to another workbook in VBA code

[gmccray]

Hi,I am trying to write the vba code to loop through eight (8) files in the same folder and copy and paste the data from one specific sheet into another workbook. I have it working except for the Loop part. Doing this also involves identifying the next empty cell. Can someone please help me to get this code to work properly. I have pasted it below. Thanks! Sub LoopAllExcelFilesInFolder()'PURPOSE: To loop through all Excel files in a user specified folder and perform a set task on themDim wb As WorkbookDim myPath As StringDim myFile As StringDim myExtension As StringDim FldrPicker As FileDialog'Optimize Macro Speed Application.ScreenUpdating = False Application.EnableEvents = False Application.Calculation = xlCalculationManual'Retrieve Target Folder Path From User Set FldrPicker = Application.FileDialog(msoFileDialogFolderPicker) With FldrPicker .Title = "Select A Target Folder" .AllowMultiSelect = False If .Show <> -1 Then GoTo NextCode myPath = .SelectedItems(1) & "C:\Coding\test" End With'In Case of CancelNextCode: myPath = myPath If myPath = "C:\Coding\test" Then GoTo ResetSettings'Target File Extension (must include wildcard "*") myExtension = "*.xls*" Dim FirstBlankCell As Range Set FirstBlankCell = Range("C" & Rows.Count).End(xlUp).Offset(1, 0) Workbooks("BiLingual_Orig_091417.xlsx").Worksheets("Intraday").Range("A6:AM103").Copy _ Workbooks("MasterBook01_Test.xlsx").Worksheets("IEX").Range("C" & Rows.Count).End(xlUp).Offset(1, 0)'Target Path with Ending Extention myFile = Dir("C:\Coding\test\*.xlsx")'Loop through each Excel file in folder Do While myFile = "*.xlsx" 'Set variable equal to opened workbook Set wb = Workbooks.Open("C:\Coding\test\BiLingual_Orig_091417.xlsx") 'Ensure Workbook has opened before moving on to next line of code DoEvents 'Change First Worksheet's Background Fill Blue wb.Worksheets(1).Range("A1:Z1").Interior.Color = RGB(51, 98, 174) 'Save and Close Workbook wb.Close SaveChanges:=True 'Ensure Workbook has closed before moving on to next line of code DoEvents 'Get next file name myFile = Dir("C:\Coding\test\*_Orig_091417.xlsx") Loop'Message Box when tasks are completed MsgBox "Task Complete!"ResetSettings: 'Reset Macro Optimization Settings Application.EnableEvents = True Application.Calculation = xlCalculationAutomatic Application.ScreenUpdating = TrueEnd Sub

 

[Joe4]

Your code wrapped into one long string and is pretty much unreadable.
Please use Code Tags around your code so we can read it.
See: https://www.mrexcel.com/forum/board-announcements/515787-how-post-your-vba-code.html

 

[mole999]

Sub LoopAllExcelFilesInFolder()

'PURPOSE: To loop through all Excel files in a user specified folder and perform a set task on them
    Dim wb As Workbook
    Dim myPath As String
    Dim myFile As String
    Dim myExtension As String
    Dim FldrPicker As FileDialog
    'Optimize Macro Speed
    Application.ScreenUpdating = False
    Application.EnableEvents = False
    Application.Calculation = xlCalculationManual
    'Retrieve Target Folder Path From User
    Set FldrPicker = Application.FileDialog(msoFileDialogFolderPicker)
    With FldrPicker
        .Title = "Select A Target Folder"
        .AllowMultiSelect = False
        If .Show <> -1 Then GoTo NextCode
        myPath = .SelectedItems(1) & "C:\Coding\test"
    End With
    'In Case of Cancel
NextCode:     myPath = myPath
    If myPath = "C:\Coding\test" Then GoTo ResetSettings
    'Target File Extension (must include wildcard "*")
    myExtension = "*.xls*"
    Dim FirstBlankCell As Range
    Set FirstBlankCell = Range("C" & Rows.Count).End(xlUp).Offset(1, 0)
    Workbooks("BiLingual_Orig_091417.xlsx").Worksheets("Intraday").Range("A6:AM103").Copy
    Workbooks("MasterBook0_Test.xlsx").Worksheets("IEX").Range("C" & Rows.Count).End(xlUp).Offset(1, 0)
    'Target Path with Ending Extention
    myFile = Dir("C:\Coding\test\*.xlsx")
    'Loop through each Excel file in folder
    Do While myFile = "*.xlsx"
        'Set variable equal to opened workbook
        Set wb = Workbooks.Open("C:\Coding\test\BiLingual_Orig_091417.xlsx")
        'Ensure Workbook has opened before moving on to next line of code
        DoEvents
        'Change First Worksheet's Background Fill Blue
        wb.Worksheets(1).Range("A1:Z1").Interior.Color = RGB(51, 98, 174)
        'Save and Close Workbook
        wb.Close SaveChanges:=True
        'Ensure Workbook has closed before moving on to next line of code
        DoEvents
        'Get next file name
        myFile = Dir("C:\Coding\test\*_Orig_091417.xlsx")
    Loop
    'Message Box when tasks are completed
    MsgBox "Task Complete!"
ResetSettings:
    'Reset Macro Optimization Settings
    Application.EnableEvents = True
    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True
End Sub

 

[gmccray]

Hi Mole999, Thanks for your kind assistance yesterday, I really appreciate it. I have tried the code and it works great except it does not open, copy and paste the other seven files. it does copy and paste the first file that is already open. Can you assist me with this again?

 

[mole999]

I didn't do anything, I just cleaned up your bad pasting so it could be read

When I compiled it
Workbooks("MasterBook0_Test.xlsx").Worksheets("IEX").Range("C" & Rows.Count).End(xlUp).Offset(1, 0)
was already an error and I couldn't see why