如何将多张excel表格合成一张

如何将多张excel表格合成一张

这个同我猜的就一样，需要VB来写了，抄袭下了 ...

复制以下代码到宏，然后在要汇总的表上创建一个对象（文本框或者图片），然后在其身上点右键，指定宏，选择我们保存的宏，汇总时，点对象即可执行汇总操作。以下就是宏内容：
Sub 将同路径下的多张工作薄中的工作表合并到当前活动的工作表()
Application.ScreenUpdating = False
Dim lj, dirname, nm
Dim a As Long
Dim i As Long
lj = ActiveWorkbook.Path
nm = ActiveWorkbook.Name
dirname = Dir(lj & "\*.xls")
Do While dirname <> ""
If dirname <> nm Then
Workbooks.Open Filename:=lj & "\" & dirname
a = Sheets.Count '读当前工作薄中的所有的工作表
Workbooks(nm).Activate
For i = 1 To a
Workbooks(dirname).Sheets(i).UsedRange.Copy Range("a65536").End(xlUp).Offset(1, 0) '复制新打开的工作簿的第一个工作表的已用区域到rng
Next i
Workbooks(dirname).Close False
End If
dirname = Dir
Loop

End Sub

如果可以，让我来试一下QQ869444062

excel工具箱下载一个，里面有这功能

朋友！你可以使用access 把你的excel 数据全部 导入 其中 然后就可以 用追加记录的方式 合并了，要比excel 操作方便许多……

可以把工作簿点开，在"sheet1"（任意表单）处点击右键，出现一系列快捷键，点击"移动或复制工作表"，会弹出一个"移动或复制工作表"选项窗口，先单击"工作簿"的下拉列表，选择你要移动的工作簿名称，然后再选择顺序"下列选定工作表之前"（不选择也行），最后单击"确定"。
我上面每一步骤都说得很详细，所以看起来会很复杂，但实际操作起来很简单的。

右击工作表标签，然后点击“移动或复制工作表”，将所需的工作表就可集中到同一工作簿中

打开excel，按alt+f11，在sheet1（sheet）右边的框框里面copy下面这些代码，再点击开始运行，就是类似△的这个标志，就可以了，后面你照着弹出来框框操作就行了。
宏：多个文件表合到一个文件表的多个SHEET中
Sub CombineWorkbooks()
Dim FilesToOpen, ft
Dim x As Integer
Application.ScreenUpdating = False
On Error GoTo errhandler
FilesToOpen = Application.GetOpenFilename _
(FileFilter:="Micrsofe Excel文件(*.xls), *.xls", _
MultiSelect:=True, Title:="要合并的文件")

If TypeName(FilesToOpen) = "boolean" Then
MsgBox "没有选定文件"
'GoTo errhandler
End If
x = 1
While x <= UBound(FilesToOpen)
Set wk = Workbooks.Open(Filename:=FilesToOpen(x))
wk.Sheets().Move after:=ThisWorkbook.Sheets _
(ThisWorkbook.Sheets.Count)
x = x + 1
Wend
MsgBox "合并成功完成！"
errhandler:
'MsgBox Err.Description
'Resume errhandler
End Sub

1、把多个excel表都放在同一个文件夹里面，并在这个文件夹里面新建一个excel。

2、用microsoft excel打开新建的excel表，并右键单击sheet1，找到“查看代码”，单击进去。进去之后就看到了宏计算界面。

3、然后把下面这些宏计算的代码复制进去，然后找到工具栏上面的“运行”下的“运行子过程/用户窗体”，代码如下，如图所示：
Sub 合并当前目录下所有工作簿的全部工作表()

Dim MyPath, MyName, AWbName

Dim Wb As Workbook, WbN As String

Dim G As Long

Dim Num As Long

Dim BOX As String

Application.ScreenUpdating = False

MyPath = ActiveWorkbook.Path

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

AWbName = ActiveWorkbook.Name

Num = 0

Do While MyName <> ""

If MyName <> AWbName Then

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

Num = Num + 1

With Workbooks(1).ActiveSheet

.Cells(.Range("B65536").End(xlUp).Row + 2, 1) = Left(MyName, Len(MyName) - 4)

For G = 1 To Sheets.Count

Wb.Sheets(G).UsedRange.Copy .Cells(.Range("B65536").End(xlUp).Row + 1, 1)

Next

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

Wb.Close False

End With

End If

MyName = Dir

Loop

Range("B1").Select

Application.ScreenUpdating = True

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

End Sub

4、运行之后，等待10秒针左右，等运行完毕，就是合并完成之后，会有提示，点确定就可以了。查看合并后的数据，有5000多行，就是同一个文件夹里面17个excel表数据合并后的结果。效果如图所示。

如以上回答内容为低俗、色情、不良、暴力、侵权、涉及违法等信息，可以点下面链接进行举报！

点此我要举报以上问答信息