VBA - Copy worksheets and rename automatically in another workbook

[cheongmarcus]

Hi, I encounter a problem and not sure how to continue from here. What i would like to do is:
First, Copy sheet 1 from all the worksheets into this new workbook where i have my macro run. (this i have no issue, here is the code)
Next, as I copy these sheets from their respective workbooks, I would like to rename these sheet copied according to its respective workbook name? (Here I do not know how to accomplish this)

So in my folder, there is 5 excel workbooks (namely A,B,C,D,E), with 10 excel worksheets within each workbook.
I am taking the first sheet of each workbook.

However, as i perform the copy of these sheets, I want to rename it according to A,B,C,D,E. So for instance, in this new workbook, as the code copies sheet 1 from workbook A, that sheet gets renamed as A, then as the code copies sheet 1 from workbook B, that sheet gets renamed as B, so on..

Any help would be very much appreciated. Thanks!!

Sub GetSheets()
Application.DisplayAlerts = False
Path = "C:\Users\cheong\Desktop\New Folder\"
Filename = Dir(Path & "*.xlsx")
Do While Filename <> ""
    Workbooks.Open Filename:=Path & Filename
    With ActiveWorkbook
        .Worksheets(1).Copy After:=ThisWorkbook.Sheets(1)
    End With
Workbooks(Filename).Close
    Filename = Dir()
Loop

End Sub

 

[Trevor G]

Add this just below With ActiveWorkbook

.Sheets(1).Name = ActiveWorkbook.Name