如何批量修改Excel每个工作表名称，名称为每个工作表相同单元格中的部分文字（每张表的文字内容不同）

Question

我有一个Excel里面包含一百多张工作表，我想把每个工作表的名称命名为每个表格的A2单元格中编号后面的那一部分文字（图中画圈的文字），每张表格的A2单元格文字都不同，请问各位有没有简便快捷的办法教我一下~？

Answer 1

Sub 提取A2命名sheet()
Dim sh As Worksheet
On Error Resume Next
For Each sh In Worksheets
If sh.Visible = -1 Then    '遍历可见sheet
a = sh.Cells(2, "A")
s = Split(a, "]")          '按“]”分割
sh.Name = s(1)             '提取第二组数据
End If
Next sh
End Sub

1、代码功能：提取A2单元格“]”后的内容，命名给当前sheet

2、代码使用方法：按alt+f11，弹出代码窗口。

3、自定义部分：

①修改分割符：代码第7行

②修改提取范围：代码第8行（注：S(0)，从0开始是第一组）

追问

超赞的这个方法！
非常感谢！
话说，能不能再教我一下，把这些工作表单独拆分成Excel文件，并且文件名和工作表的名字都一致咋弄~

追答Sub 拆分工作表()
'功能：拆分可见sheet到指定目录，文件名与sheet名相同
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Dim wb As Workbook
Dim sh As Worksheet
wbname = "111.xlsx"       '指定要拆分的文件名
patth = "d:\"             '指定拆分到哪里，默认D:\盘
For Each sh In Workbooks(wbname).Worksheets
If sh.Visible = xlSheetVisible Then
Set wb = Workbooks.Add
Workbooks(wbname).Sheets(sh.Name).Copy wb.Worksheets(1)
ActiveWorkbook.Worksheets("Sheet1").Delete
If sh.Name & ".xlsx" <> wbname Then     '排除sheet名称与文件名相同
ActiveWorkbook.SaveAs patth & sh.Name & ".xlsx"
Else
ActiveWorkbook.SaveAs patth & sh.Name & " " & ".xlsx"
End If
ActiveWorkbook.Close True
End If
Next sh
Application.DisplayAlerts = True
Application.ScreenUpdating = True
MsgBox "完成！"
End Sub

这是拆分工作表的代码：

指定当前拆分的工作簿名称：代码7行

修改文件输出路径：代码8行

Answer 2

反过来操作是简单的，没有按你这样想过和做过，估计是要VBA操作吧……
但是给你一个建议：
你这样的这个表名称很好的呀，若是按你的操作还是解决不了表格的选择和查找哦！不如新建一个工作表，把所有表格的A2单元格编号后面的文字提取出来变成目录表，然后每一个做一个链接，今后只要点一下目录表中的名称就自动指向对应的工作表了，很方便哦……

Answer 3

这个需要写代码来做了，循环语句遍历所有的工作表，提取a2单元格"]"后面的文字，将工作表重新命名。手工完成是很麻烦的！
你可以上传表格过来吗？追问

额，不好意思，这是企业内部账务，不可以上传呐~
可以告诉我操作方法吗？谢谢啦！

追答

删除第三行以后的数据，然后发送其中几个工作表，这样好做测试。