Copy from multiple worksheets and multiple source files in a folder and paste into multiple sheets in target workbook

[Hs72711]

Hi I have the code below however I need it to pick up a range of tabs in both the source files and the target files. The worksheets range from WK1 to Wk 53.

Option Explicit


Const FOLDER_PATH = "C:\temp\Users\User1\My Documents\Times\" 'REMEMBER END BACKSLASH


Sub ImportWorksheets()
'=============================================
'Process all Excel files in specified folder
'=============================================
Dim sFile As String 'file to process
Dim wsTarget As Worksheet
Dim wbSource As Workbook
Dim wsSource As Worksheet
Dim rowTarget As Long 'output row

rowTarget = 2

'check the folder exists
If Not FileFolderExists(FOLDER_PATH) Then
MsgBox "Specified folder does not exist, exiting!"
Exit Sub
End If

'reset application settings in event of error
On Error GoTo errHandler
Application.ScreenUpdating = False

'set up the target worksheet
Set wsTarget = Sheets("Sheet2")

'loop through the Excel files in the folder
sFile = Dir(FOLDER_PATH & "*.xls*")
Do Until sFile = ""

'open the source file and set the source worksheet - ASSUMED WORKSHEET(1)
Set wbSource = Workbooks.Open(FOLDER_PATH & sFile)
Set wsSource = wbSource.Worksheets(1) 'EDIT IF NECESSARY

'import the data
With wsTarget
.Range("A" & rowTarget).Value = wsSource.Range("C2").Value
.Range("B" & rowTarget).Value = wsSource.Range("D2").Value
.Range("C" & rowTarget).Value = wsSource.Range("E2").Value
.Range("D" & rowTarget).Value = wsSource.Range("F2").Value
.Range("E" & rowTarget).Value = wsSource.Range("B7").Value
.Range("F" & rowTarget).Value = wsSource.Range("H5").Value
.Range("G" & rowTarget).Value = wsSource.Range("L6").Value
.Range("H" & rowTarget).Value = wsSource.Range("M7").Value
.Range("I" & rowTarget).Value = wsSource.Range("N8").Value
.Range("J" & rowTarget).Value = wsSource.Range("N9").Value
.Range("K" & rowTarget).Value = wsSource.Range("N10").Value
.Range("L" & rowTarget).Value = wsSource.Range("N11").Value
.Range("M" & rowTarget).Value = wsSource.Range("N12").Value

'optional source filename in the last column
.Range("N" & rowTarget).Value = sFile
End With

'close the source workbook, increment the output row and get the next file
wbSource.Close SaveChanges:=False
rowTarget = rowTarget + 1
sFile = Dir()
Loop

errHandler:
On Error Resume Next
Application.ScreenUpdating = True

'tidy up
Set wsSource = Nothing
Set wbSource = Nothing
Set wsTarget = Nothing
End Sub




Private Function FileFolderExists(strPath As String) As Boolean
If Not Dir(strPath, vbDirectory) = vbNullString Then FileFolderExists = True
End Function