EXCEL怎样合并多少工作薄?

发布网友 发布时间：2022-05-19 21:32

我来回答

共3个回答

热心网友 时间：2023-10-18 08:18

批量合并多个工作簿，用宏代码实现较好，建一个文件夹，取名：分表，打开一个工作表，ALT+F11，将以下代码拷贝至模块中。

Sub 合并数据()
Dim myPath$, myFile$, AK As Workbook, aRow%, tRow%, i As Integer
Application.ScreenUpdating = False '冻结屏幕，以防屏幕抖动
myPath = ThisWorkbook.Path & "\分表\" '把文件路径定义给变量

myFile = Dir(myPath & "*.xls") '依次找寻指定路径中的*.xls文件
Do While myFile <> "" '当指定路径中有文件时进行循环
If myFile <> ThisWorkbook.Name Then
Set AK = Workbooks.Open(myPath & myFile) '打开符合要求的文件
For i = 1 To AK.Sheets.Count
aRow = AK.Sheets(i).Range("a65536").End(xlUp).Row
tRow = ThisWorkbook.Sheets(1).Range("a65536").End(xlUp).Row + 1

'AK.Sheets(i).Select
AK.Sheets(i).Range("A2:N" & aRow).Copy ThisWorkbook.Sheets(1).Range("a" & tRow) '取得第3行以后的数据,从A到N列
Next
Workbooks(myFile).Close False '关闭源工作簿,并不作修改
End If
myFile = Dir '找寻下一个*.xls文件
Loop

Application.ScreenUpdating = True '冻结屏幕,此类语句一般成对使用
MsgBox "汇总完成，请查看！", 64, "提示"

End Sub

热心网友 时间：2023-10-18 08:18

我给你一个例子
Sub 汇总各车间工资表()
Dim lj, dirname, nm
Dim a, i As Long
Dim S As String

S = "车间工资表汇总"

For i = 1 To Sheets.Count
If S = Sheets(i).Name Then
MsgBox "该名称的工作表已经存在！", vbCritical, "警告"
'Exit Sub
GoTo 40
End If
Next i

ThisWorkbook.Unprotect
Sheets.Add Before:=Worksheets(Worksheets.Count - 1)
ThisWorkbook.Unprotect
ActiveSheet.Name = S
ThisWorkbook.Protect Structure:=True

40 Application.ScreenUpdating = False

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

MsgBox "各车间工资表汇总完毕!"
End Sub追问还是看不明白怎样搞。。

热心网友 时间：2023-10-18 08:19

我是用下面的代码合并工作簿的，可以试一下：

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追问还是不知道怎样搞啊

追答打开你的一个ECXEL，按ALT+F11，把上面的代码复制到模块中去，按F5运行，再选择你要合并的工作簿所在路径即可。