将所有工作表名称重命名为文件夹中的工作簿名称

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部分的循环。