如何将包含多个工作表的工作簿合并成一个工作簿

smartelfs

现有几个工作簿 ，每个工作簿包含几个工作表，现要将这几个工作簿合并成一个（包含的几个工作表也要合并）。

合并效果已包含在附件中。

从网上搜了代码 ，看不大懂，求大神指教！

Sub 合并当前目录下所有工作簿的全部工作表()

Dim MyPath, MyName, AWbName

Dim Wb As Workbook, WbN As String

Dim G As Long

Dim Num, ini As Long

Application.ScreenUpdating = False

MyPath = ActiveWorkbook.Path

MyName = Dir(MyPath & "\" & "*.xls")

AWbName = ActiveWorkbook.Name

Num = 0

ini = 0

Do While MyName <> ""

If MyName <> AWbName Then

Set Wb = Workbooks.Open(MyPath & "\" & MyName)

Num = Num + 1

With Workbooks(1).ActiveSheet

If ini = 0 Then

Wb.Sheets(1).Range(Wb.Sheets(1).Cells(1, 1),Wb.Sheets(1).Cells(1,Wb.Sheets(1).UsedRange.Columns.Count)).Copy .Cells(1, 1)

ini=1

End If

For G=1 To Sheets.Count

Wb.Sheets(G).Range(Wb.Sheets(G).Cells(2,1),Wb.Sheets(G).Cells(Wb.Sheets(G).UsedRange.Rows.Count,Wb.Sheets(G).UsedRange.Columns.Count)).Copy .Cells(.Range("A65536").End(xlUp).Row+1,1)

Next

WbN=WbN & Chr(13) & Wb.Name

Wb.Close False

End With

End If

MyName=Dir

Loop

Range("A1").Select

Application.ScreenUpdating = True

MsgBox "共合并了" & Num & "个工作薄下的全部工作表。如下：" & Chr(13) & WbN, vbInformation, "提示"

End Sub

表格.rar (19.33 KB, 下载次数: 275)

2014-10-8 23:17 上传

点击文件名下载附件
合并前和合并后的表格

smartelfs

求大神指教～～～～～～～～

wbjiqpl

关注此帖，如果能指定只合并某张工作表就好了，还有高手一起解决。

smartelfs

wbjiqpl 发表于 2014-10-9 00:09
关注此帖，如果能指定只合并某张工作表就好了，还有高手一起解决。

里面的4张工作表都要合并

liulang0808

http://club.excelhome.net/blog-238368-1694.html
遍历各个工作薄及其表，然后看具体怎么合并吧
上面的是个参考

smartelfs

liulang0808 发表于 2014-10-9 08:46
http://club.excelhome.net/blog-238368-1694.html
遍历各个工作薄及其表，然后看具体怎么合并吧
上面的是 ...

刚接触excel的这些功能，代码看不大懂啊 方便加个Q么？ 比较急，领导让明天给出解决方案。谢谢

liulang0808

Sub 按钮1_Click()
    Application.ScreenUpdating = False
    Set fso = CreateObject("scripting.filesystemobject")
    Set ff = fso.getfolder(ThisWorkbook.Path) '
    Set wb = ThisWorkbook
    For Each f In ff.Files
   
        If f.Name <> ThisWorkbook.Name Then
            Set wb1 = Workbooks.Open(f)
            For j = 1 To Workbooks(f.Name).Sheets.Count '遍历打开文件的每一张表格
                If Len(wb1.Sheets(j).Cells(6, 1)) > 0 Then
                    a = wb1.Sheets(j).UsedRange.Rows.Count - 3
                    wb1.Sheets(j).Rows("6:" & a).Copy wb.Sheets(wb1.Sheets(j).Name).Cells(Rows.Count, 1).End(3).Offset(1)
                End If
            Next j
        wb1.Close
        End If
    Next f
    Application.ScreenUpdating = True
End Sub

a68508122

表格.rar (29.02 KB, 下载次数: 898)

2014-10-9 09:42 上传

点击文件名下载附件

以上 希望您满意
使用方法：打开 合并后表格.xls文件 点击橘色的import 惊喜来了

smartelfs

a68508122 发表于 2014-10-9 09:42
以上 希望您满意
使用方法：打开 合并后表格.xls文件 点击橘色的import 惊喜来了

牛人啊，下面能不能在加一行，把各列的值（除机构号外）相加？

a68508122

smartelfs 发表于 2014-10-9 10:10
牛人啊，下面能不能在加一行，把各列的值（除机构号外）相加？

给个结果物。。做参照