Rename all worksheet names as workbook names in a folder

Question

Seeking support to edit below codes in such a way that it renames all worksheets (excel) similar to their workbooknames within a folder (loop). If workbook has more than one sheet then rename it as workbookname(1),workbookname(2) etc.

Sub EditSheetName()
Dim NewName
NewName = Replace(ActiveWorkbook. Name, ".xl*", "")
ActiveSheet.Select
ActiveSheet.Name = NewName
End Sub

Answer 1

Maybe just a simple loop: I haven't figured out how to replace the ".xlsx" using a wildcard, I would assume it would be either ".xlsm" or ".xlsx", you can change them in the code

    Sub LoopThroughFolder()

    Dim MyFile As String, Str As String, MyDir As String, Wb As Workbook
    Dim sh As Worksheet
    Dim s As String, n As String



    Set Wb = ThisWorkbook
    'change the address to suite
    MyDir = "C:\Users\dmorrison\Downloads\TestFolderLoop\"
    MyFile = Dir(MyDir & "*.xls*")    'change file extension
    ChDir MyDir
    Application.ScreenUpdating = 0
    Application.DisplayAlerts = 0

    Do While MyFile <> ""
        Workbooks.Open (MyFile)
        s = ActiveWorkbook.Name
        n = Replace(s, ".xls", "")    'change the file extension
        i = 1
        For Each sh In Sheets
            sh.Name = n & "(" & i & ")"
            i = i + 1
        Next sh
        ActiveWorkbook.Close True

        MyFile = Dir()
    Loop



End Sub

Answer 2

For multiple sheets, you will want an if statement:

Dim s As String, i as Integer
If Sheets.Count=1 Then
    s = Replace(ActiveWorkbook.Name,".xlsx","")
    ActiveSheet.Name = s        
Else
    For i = 1 to Sheets.Count
        s = Replace(ActiveWorkbook.Name,".xlsx","")
        Sheets(i).Name = s  & "(" & i & ")"
    Next i
End If

I have it this way so the (#) only shows up for multiple. You would only need the loop in the Else section if you don't care.