Simplifying and looping VBA

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

Code:

---

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

---

Code:

---

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

---

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?