Copy a range of cells from multiple worksheets in multiple workbooks

Hello

I have a macro that allows me to copy a range of cells from a nominated worksheet that exists in several workbooks from a localised folder into one master sheet, see code below. It works really well I especially like being able to change the worksheet names and range of cells as depending on the project I am working on they may vary.

However I'd like to expand on this macro and instead of updating the worksheet name each time I want to copy data, I'd like to add all the worksheet names into the macro and have the ranges appear on new worksheets in the master (labelled with the name of the worksheet they have been copied from). See example attached (includes codes as well).

I'd appreciate any help you can give on how to achieve this.

Claire

Sub CopyRange()
 Application.ScreenUpdating = False
 Dim wkbDest As Workbook
 Dim wkbSource As Workbook
 Set wkbDest = ThisWorkbook
 Dim LastRow As Long
 Const strPath As String = "C:\Users\Desktop\StarTrek\"
 ChDir strPath
 strExtension = Dir("*.xls*")
 Do While strExtension <> ""
 Set wkbSource = Workbooks.Open(strPath & strExtension)
 With wkbSource
 LastRow = .Sheets("project_level1A").Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
 
 
Dim rLastCell As Range

Set rLastCell = wkbDest.Sheets("Master").Cells.Find(What:="*", After:=wkbDest.Sheets("Master").Cells(1, 1), LookIn:=xlFormulas, LookAt:= _
xlPart, SearchOrder:=xlByColumns, SearchDirection:=xlPrevious, MatchCase:=False)
 
 If rLastCell Is Nothing Then Set rLastCell = wkbDest.Sheets("Master").Cells(1, 1)
 
 wkbDest.Sheets("Master").Cells(2, rLastCell.Column).Offset(-1, 1).Value = wkbSource.Name
 
 wkbDest.Sheets("Master").Cells(2, rLastCell.Column + 1).Resize(LastRow, 4).Value = .Sheets("project_level1A").Range("a1:d" & LastRow).Value
 .Close savechanges:=False
                                                                                                                                        
 End With
 strExtension = Dir
 Loop
 Application.ScreenUpdating = True
End Sub