Simplifying and looping VBA

[InzieBear]

I'm pretty new to VBA and I can do basic things. I'm trying to create a master file based on individual entries.

The "master file" has a page called summary then an individual tab per file (E0462, E1262, E1362.....) The source files are all titled "Weekly Forecast E***" and are saved in a folder called Source Files.

I want to copy and paste the following ranges from the tab titled "Weekly Forecast" (Sheet 1) B22:H46, J22:J46, B69:H71, J69:J71 and B75:J75, J75:J77 into the correct tab in the master file. Ie data from "Weekly Forecast E0462" will be pasted into tab E0462.

I have managed to create a macro below only does for one sheet... Can someone help me on how to loop for all files in a saved folder and make sure they save in the correct tab? I have highlighted where the problem is...but im really not sure how to adapt... I think I have to activate the current sheet, highlight the cells, copy, then activate the master file, select where I want to paste, then paste special... The problem is switching between the Master and the "open file" which will change depending on the which file is open. I also don't know how to select a particular tab based on the open file.

My VBA is below....

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

  Application.ScreenUpdating = False
  Application.EnableEvents = False
  Application.Calculation = xlCalculationManual

  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

NextCode:
  myPath = myPath
  If myPath = "" Then GoTo ResetSettings

  myExtension = "*.xls*"

  myFile = Dir(myPath & myExtension)

  Do While myFile <> ""
    'Set variable equal to opened workbook
      Set wb = Workbooks.Open(Filename:=myPath & myFile)
    
    
      DoEvents
    
    
      Sheets("Weekly Forecast").Select
    Range("B22:H46").Select
    Selection.Copy
    Windows("Weekly_Forecast_Dashboard.xlsm").Activate
    Range("B22").Select
    Sheets("E0462").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    
    
      wb.Close SaveChanges:=True
      
    
      DoEvents
    'Get next file name
      myFile = Dir
  Loop

  MsgBox "Task Complete!"
ResetSettings:
  
    Application.EnableEvents = True
    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True
End Sub

[mana]

Option Explicit

Sub Copy_Paste()
    Dim wb As Workbook
    Dim myPath As String
    Dim buf As String
    Dim ws As Worksheet
    Dim shn As String

    Set wb = Workbooks("Weekly_Forecast_Dashboard.xlsm")
    
    myPath = wb.Path & "\"
    buf = Dir(myPath & "Weekly_Forecast_E*.xlsx")
    
    Do While buf <> ""
        Set ws = Workbooks.Open(myPath & buf).Sheets("Weekly Forecast")
        shn = Mid(Split(buf, "_")(2), 1, 5)
        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("J75:J77").Value = ws.Range("J75:J77").Value
            .Range("B75:H77").Value = ws.Range("B75:H77").Value
        End With
        ws.Parent.Close SaveChanges:=False
        buf = Dir()
    Loop

End Sub

[InzieBear]

Hi Mana,

Thanks for taking the time to reply. Can you maybe help me understand your coding. As I say I am pretty new to VBA and learning as I go.

I presume this code you have presented above completed supersedes that one I have done ....Also can you confirm that this is going to paste the exact values in the Master Worksheet?