Looping through eight (8) Excel files in a folder, finding the first blank cell on a spreadsheet and copying and pasting to that sheet each of the eig

[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 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