VBA Loop help (Error Loop without Do)

[InzieBear]

I'm trying to create a VBA to open all files in a folder, copy the sheet named "Weekly Forecast" and place it into the tab named after the file.... [File name "Weekly Forecast E0462" tab "E0462" : File name "Weekly Forecast E1262" tab "E1262" for example]

Ive got the vba below and it looks like it would work...but I keep getting a Loop without Do bug error.
Can someone help ?

Sub LoopAllExcelFilesInFolder()

Dim wb As Workbook
Dim ws As Worksheet
Dim myPath As String
Dim myFile As String
Dim myExtension As String
Dim FldrPicker As FileDialog
Dim buf As String
Dim shn As String
Dim x As Workbook
Dim y As Workbook
Set x = Workbooks.Open(Filename:=myPath & myFile)
Set y = Workbooks("Weekly_Forecast_Dashboard.xlsm")
'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 = "C:\Users\10053845\Desktop\Trial\Source Files"
      .AllowMultiSelect = False
        If .Show <> -1 Then GoTo NextCode
        myPath = .SelectedItems(1) & "\"
    End With
Set wb = Workbooks("Weekly_Forecast_Dashboard.xlsm")
'In Case of Cancel
NextCode:
  myPath = wb.Path & "/"
  buf = Dir(myPath & "Weekly_Forecast_E*.XLsx")
  If myPath = "" Then GoTo ResetSettings
'Target File Extension (must include wildcard "*")
  myExtension = "*.xls*"
'Target Path with Ending Extention
  myFile = Dir(myPath & myExtension)
'Loop through each Excel file in folder
  Do While buf <> ""
    'Set variable equal to opened workbook
    Set wb = Workbooks.Open(Filename:=myPath & myFile)
      Set ws = Workbooks.Open(myPath & buf).Sheets("Weekly Forecast")
      shn = Mid(Split(buf, "_")(2), 1, 5)
       
      
    
    'Ensure Workbook has opened before moving on to next line of code
      DoEvents
    
    'Copy Selected range
      With wb.Worksheets(shn)
      .Range("B22:H46").Value = ws.Range("B22:H46").Value
      .Range("J22:J46").Value = ws.Range("J22:J46").Value
      .Range("B69:H71").Value = ws.Range("B69:H71").Value
      .Range("J69:J71").Value = ws.Range("J69:J71").Value
      .Range("B75:H77").Value = ws.Range("B75:H77").Value
      .Range("J75:J77").Value = ws.Range("J75:J77").Value
    
    '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
      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

[GTO]

Cross-posted and answered Here

Inziebear - Please read This Article

[Paul_Hossler]

You missed an 'End With'

Formatting with indent level and adding a blank line between logical blocks makes it much easier to see things like that

Option Explicit

 
Sub LoopAllExcelFilesInFolder()
     
    Dim wb As Workbook
    Dim ws As Worksheet
    Dim myPath As String
    Dim myFile As String
    Dim myExtension As String
    Dim FldrPicker As FileDialog
    Dim buf As String
    Dim shn As String
    Dim x As Workbook
    Dim y As Workbook
    
    Set x = Workbooks.Open(Filename:=myPath & myFile)
    Set y = Workbooks("Weekly_Forecast_Dashboard.xlsm")
     
     '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 = "C:\Users\10053845\Desktop\Trial\Source Files"
        .AllowMultiSelect = False
        If .Show <> -1 Then GoTo NextCode
        myPath = .SelectedItems(1) & "\"
    End With
    Set wb = Workbooks("Weekly_Forecast_Dashboard.xlsm")
     
     'In Case of Cancel
NextCode:
    
    myPath = wb.Path & "/"
    buf = Dir(myPath & "Weekly_Forecast_E*.XLsx")
    
    If myPath = "" Then GoTo ResetSettings
         
     'Target File Extension (must include wildcard "*")
    myExtension = "*.xls*"
     
     'Target Path with Ending Extention
    myFile = Dir(myPath & myExtension)
     
     'Loop through each Excel file in folder
    Do While buf <> ""
         'Set variable equal to opened workbook
        Set wb = Workbooks.Open(Filename:=myPath & myFile)
        Set ws = Workbooks.Open(myPath & buf).Sheets("Weekly Forecast")
        shn = Mid(Split(buf, "_")(2), 1, 5)
         
         
         
         'Ensure Workbook has opened before moving on to next line of code
        DoEvents
         
         'Copy Selected range
        With wb.Worksheets(shn)
            .Range("B22:H46").Value = ws.Range("B22:H46").Value
            .Range("J22:J46").Value = ws.Range("J22:J46").Value
            .Range("B69:H71").Value = ws.Range("B69:H71").Value
            .Range("J69:J71").Value = ws.Range("J69:J71").Value
            .Range("B75:H77").Value = ws.Range("B75:H77").Value
            .Range("J75:J77").Value = ws.Range("J75:J77").Value
        End With    '<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
             
        '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
    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

Edit:

Cross-posted and answered Here

Inziebear - Please read This Article

I didn't see GTO's post - THAT'S why we like to know about a multi-post so that if it's solved, then we don't need to waste time and effort on a non-problem

[Aussiebear]

Its a shame about the cross posting... Why is it the people cannot understand that VBA is not that big of an internet issue that members here are also members of other forums? You cannot hide if you are chasing issues with vba.... My guess is that it comes done to moral integrity. Or the lack thereof!

[Paul_Hossler]

@Aussiebear --

I was going to volunteer my 2 cents here, but I put them in the mod forum instead

[mana]

Sorry.
Perhaps InzieBear got hurried because I was not able to answer .
Simplifying and looping VBA