將所有工作表名稱重命名爲文件夾中的工作簿名稱

Question

尋求支持以編輯以下代碼的方式重命名與文件夾（循環）中的工作簿名稱相似的所有工作表（excel）。如果工作簿中有一個以上的表，然後將其重命名爲workbookname（1），workbookname（2）等

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

Answer 1

也許只是一個簡單的循環： 我還沒有想出如何更換「的.xlsx」使用通配符，我會以爲這將是要麼「.XLSM」或「的.xlsx」，你可以在代碼

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

對於多張改變他們，你會想一個if語句：

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 

我h以這種方式這樣（＃）只顯示多個。如果你不在意，你只需要Else部分的循環。