如何把几个excel文件中的工作表合并到一个文件中并生成目录

是 否 +2 论坛币

k人 参与回答

经管之家送您一份

应届毕业生专属福利!

求职就业群

赵安豆老师微信：zhaoandou666

经管之家联合CDA

送您一个全额奖学金名额~ !

立即领取

感谢您参与论坛问题回答

经管之家送您两个论坛币！

+2 论坛币

下载的统计年鉴，是excel格式的，一堆表格文件，怎么样能把它们放到一个文件中并做成目录。例子见附件
示例.rar (42.53 KB)

2012-2-26 14:41:14 上传

扫码加我 拉你入群

请注明：姓名-公司-职位

以便审核进群资格，未注明则拒绝

分享0 收藏0 回帖

关键词：EXCEL xcel exce cel 工作表 excel 目录 工作表 如何

如果文件名都是有规律的，写个VBA很容易啊。
目录就是在单独一个sheet里做个超链呗

好东西啊！谢谢楼主分享啊！

Sub 合并汇总()
Application.DisplayAlerts = False
Application.ScreenUpdating = False
FileToOpen_N = Application.GetOpenFilename("xls文件,*.xls", _
Title:="请选择要合并工作簿：", MultiSelect:=True)
Newbz = 0
On Error Resume Next
For Each FileToOpen In FileToOpen_N
If FileToOpen <> False Then
If Newbz = 0 Then
Booknum = Application.SheetsInNewWorkbook
Application.SheetsInNewWorkbook = 1
Workbooks.Add
Application.SheetsInNewWorkbook = Booknum
NewBookName = ActiveWorkbook.Name
Sheets(1).Name = "sheet_tmp"
Newbz = 1
End If
Set OpenBook = Workbooks.Open(FileToOpen)
For Each Xlsheet In OpenBook.Sheets
Xlsheet.Copy Before:=Workbooks(NewBookName).Sheets("sheet_tmp")
Next
OpenBook.Close SaveChanges:=False
End If
Next
Workbooks(NewBookName).Sheets("sheet_tmp").Delete
Application.ScreenUpdating = True
Application.DisplayAlerts = True

Dim sht As Worksheet, lstRowZb As Integer, lstRow As Integer
'lstRowZb:总表的lastrow
Worksheets("1").Select
Worksheets("1").Range("a1:h1").Copy Destination:=Range("a1")
'复制表头
For Each sht In Worksheets
lstRowZb = Range("a65536").End(xlUp).Row '每次COPY前取得总表的最后一行
With sht
If .Name <> "1" Then
lstRow = .Range("a65536").End(xlUp).Row
.Range("a2:h" & lstRow).Copy Destination:=Cells(lstRowZb + 1, "a")
End If
End With
Next sht
End Sub