请增加自动提取工作表名称的VBA<em>代码</em>

Sub zz()
Dim d, ar, br, j% 
Set d = CreateObject("Scripting.Dictionary")'定义一个字典
Application.ScreenUpdating = False  关闭屏幕刷e68a84e799bee5baa6e997aee7ad94339新
ar = Sheet1.Range("A1").CurrentRegion   ar数组等于sheet1（这个工作表不一定是第一张工作表 ，而是一vba窗口那里排序的表）a1的连续单元格
br = Sheet111.Range("B3").CurrentRegion   br= sheet111的b3连续单元格 
For i = 2 To UBound(ar)   对i进行循环
d(ar(i, 5) & ar(i, 2)) = d(ar(i, 5) & ar(i, 2)) + ar(i, 10)   对字典值进行累加
Next
For i = 2 To UBound(br)    取br的最大行  循环
For j = 7 To UBound(br, 2)        取br的最大列循环
br(i, j) = d(br(i, 4) & br(1, j))         
Next 
Next
Sheet111.Range("B3").CurrentRegion = br  对br输出工作表
Application.ScreenUpdating = True   
End Sub

你要提取sheet名？很简单，一个循环就搞定了
我以前答百过这题
Sub paixu()
Dim i%
Dim j%
if Worksheets.Count=1 Then End
For j = 1 To Worksheets.Count - 1
For i = 1 To Worksheets.Count-1
If Sheets(i).Name > Sheets(i + 1).Name Then
Sheets(i + 1).Move Before:=Sheets(i)
End If
Next i
Next j
End Sub

用宏即可，点击录制宏，再停止录度制，然后编问辑这个空的宏代码，答把上述的命令复制进去替代版，运行这个宏命令即可。权宏也是VBA的一部分。

Sub Sort_Sheets()
Dim sCount As Integer, I As Integer, R As Integer
ReDim Na(0) As String    '声明数组e799bee5baa6e79fa5e98193e59b9ee7ad94364Na
sCount = Sheets.Count   '统计工作表数量。
'------------收集所有工作表名称代码段--------------
For I = 1 To sCount
    ReDim Preserve Na(I) As String 'Na被声明为动态数组，数组元素个数随I值发化变化
    Na(I) = Sheets(I).Name   '将第I个工作表名称存入数组
Next
'------------在数组中对名称进行排序-----------------
For I = 1 To sCount - 1 '从1到工作表数-1
    For R = I + 1 To sCount '从i+1到工作表数
        If Na(R) < Na(I) Then '若Na(R)<Na(i),将相邻两个数组元素(工作表名称)比较大小。文本也可比大小！
            JH = Na(I) '本句和接下来两句，将Na(I)与Na(R)内容互换
            Na(I) = Na(R)
            Na(R) = JH
        End If
    Next
Next
'------------根据数组中排好的顺序，将相应工作表移到最后-------完成排序
For I = 1 To sCount  '
    Sheets(Na(I)).Move After:=Sheets(I)
Next
End Sub