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