excel 表合并，超链，重命名

+++++++++++++++在新建的工作簿中，Alt+F11 ,Alt+I+M 粘贴下面代码，选择要合并的工作簿，F5运行，就能把多个工作簿下的表合并在新建的工作簿中
Sub 工作薄间工作表合并()
Dim FileOpen
Dim X As Integer
Application.ScreenUpdating = False
FileOpen = Application.GetOpenFilename(FileFilter:="Microsoft Excel文件(*.xlsx),*.xlsx", MultiSelect:=True, Title:="合并工作表")
X = 1
While X <= UBound(FileOpen)
Workbooks.Open Filename:=FileOpen(X)
Sheets().Move After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)
X = X + 1
Wend
ExitHandler:
Application.ScreenUpdating = True
Exit Sub
errhadler:
MsgBox Err.Description
End Sub


===============================================槽连接








============在sheet1粘贴运行==================在sheet1中生成整个工作簿的超链接目录，目录项为各表表名。====
Sub Add_Sheets_Link()
For i = 1 To ThisWorkbook.Worksheets.Count
Cells(i + 1, 2).Value = Worksheets(i).Name
Worksheets(1).Hyperlinks.Add Anchor:=Worksheets(1).Cells(i + 1, 2), Address:="", SubAddress:="'" & Worksheets(1).Cells(i + 1, 2) & "'!" & "A1", TextToDisplay:=Worksheets(1).Cells(i + 1, 2) & "!" & "A1"
       Worksheets(1).Cells(i + 1, 2).Value = Worksheets(i).Name
Next
For i = 1 To ThisWorkbook.Worksheets.Count
Worksheets(i).Hyperlinks.Add Anchor:=Worksheets(i).Cells(1, 10), Address:="", SubAddress:= _
       "Sheet1!B" & i + 1, TextToDisplay:="返回目录"
Next
End Sub










===========把一个工作簿下的表批量重命名，=工作簿名+表名
===同一目录下新建表，粘贴运行，会把同一目录下其他表重命名
Sub Rename()
Dim str, Filename, wb, sht, ke, dic, dic2
Dim rng As Range, firstadd, MyFileName
Dim lujing As String
Set dic = CreateObject("Scripting.Dictionary")
lujing = Left(ActiveWorkbook.FullName, InStrRev(ActiveWorkbook.FullName, "\"))
MyFileName = Dir(lujing & "*.xlsx") '这里修改文件类型,03版改为.xls就好了。
Do While MyFileName <> ""
    dic(lujing & "\" & MyFileName) = MyFileName
    MyFileName = Dir
Loop
For Each ke In dic.keys
    Set wb = GetObject(ke)
    With wb
        For Each sht In .Worksheets
            sht.name=.name & sht.name
        Next
    End With
    wb.save
    wb.close
    set wb=nothing
Next
End Sub