2020-12-09 Excel多个文件合并为一个工作薄且生成目录

多个excel文件,希望可以修改为用一个工作薄的多个工作表结构体现

Sub Books2Sheets()
    '定义对话框变量
    Dim fd As FileDialog
    Set fd = Application.FileDialog(msoFileDialogFilePicker)
    '新建一个工作簿
    Dim newwb As Workbook
    Set newwb = Workbooks.Add
    With fd
        If .Show = -1 Then
            '定义单个文件变量
            Dim vrtSelectedItem As Variant
            '定义循环变量
            Dim i As Integer
            i = 1
            '开始文件检索
            For Each vrtSelectedItem In .SelectedItems
            '打开被合并工作簿
            Dim tempwb As Workbook
            Set tempwb = Workbooks.Open(vrtSelectedItem)
            '复制工作表
            tempwb.Worksheets(1).Copy Before:=newwb.Worksheets(i)
            '把新工作簿的工作表名字改成被复制工作簿文件名
            newwb.Worksheets(i).Name = VBA.Replace(tempwb.Name, ".xlsx", "")
            '关闭被合并工作簿
            tempwb.Close SaveChanges:=False
            i = i + 1
            Next vrtSelectedItem
        End If
    End With
    Set fd = Nothing
End Sub

生成目录

1、A1单元格定义公式(ctr+F3)命名为sheet:
=REPLACE(GET.WORKBOOK(1),1,FIND("]",GET.WORKBOOK(1)),)&T(NOW())
2、在A1单元格键入:
=IFERROR(HYPERLINK("#'"&INDEX(sheet,ROW(A2))&"'!a1",INDEX(sheet,ROW(A2))),"")
3、下拉

参考链接:
https://jingyan.baidu.com/article/3a2f7c2ea4809866afd611ed.html
https://blog.csdn.net/liuxiaoshuang002/article/details/88218655
http://club.excelhome.net/thread-1178425-1-1.html

你可能感兴趣的:(2020-12-09 Excel多个文件合并为一个工作薄且生成目录)