循环改工作簿和工作表名

Sub 循环改工作簿和工作表名()
    Dim myPath$, myFile$, sht As Worksheet
    Dim s As String, s1 As String
    Dim a, b
    myPath = ThisWorkbook.Path                   '给路径变量赋值
    myFile = Dir(myPath & "\*.xls")               '用dir函数提取一个文件名
    Application.ScreenUpdating = False           '关闭屏幕刷新
    Application.DisplayAlerts = False            '禁用所有事件
        Do While myFile <> "" '当文件名不为空循环
        Workbooks.Open myPath & "\" & myFile          '打开一个文件
        For Each sht In Sheets                    '对这个文件的每个工作表(这里假设每个文件的工作表数不定)
        s = sht.Name
        a = Split(s, "_")
        b = Split(a(2), "-")
        a(2) = b(0) & b(1) & b(2)
        s1 = a(0) & "_" & a(2)
        sht.Name = s1
        Next                                   '继续循环打开文件的每个工作表，这里不会循环了，因为每个文件只有一张表
        ActiveWorkbook.SaveAs ThisWorkbook.Path & "\" & "数据\" & s1 & ".xls"
        ActiveWorkbook.Close savechanges:=True '关闭打开的工作簿
        myFile = Dir                             '再用dir函数提取一个文件名
        Loop                                      '继续循环，重复上述过程
    Application.DisplayAlerts = True      '      启用所有事件
    Application.ScreenUpdating = True            '打开屏幕刷新
End Sub