如何快速把一个excel中多个sheet合并到一张sheet上

2024-12-11 17:20:13
推荐回答(1个)
回答1:

用vba可以实现。下面这个程序是读取当前文件夹中所有的excel工作簿,将每个工作簿中的第一张表复制后粘贴到当前工作簿的一个汇总表格中。代码如下:
Sub 合并()
Application.ScreenUpdating = False
Application.DisplayAlerts = False
'Application.DisplayAlerts = False
Application.CutCopyMode = False
'MYP = "待读取文件"
myw = ActiveWorkbook.Name
Dim FILENAME As String
Dim mypath As String
Dim ZZ As Long
Sheets("原始数据合并").Range("a1:zz1000000").Clear
'mypath = ThisWorkbook.Path & "\" & MYP
mypath = ThisWorkbook.Path
ZZ = 1: XH = 0 'ZZ-写入的位置 xh-序号
MYFILE = Dir(mypath & "\" & "*.xls*")
Do While MYFILE <> ""
If MYFILE = "" Then
Exit Do '当MyFile为空的时候就说明已经遍历完了,这时退出Do,否则还要运行一遍
End If
If InStr(MYFILE, "编码合并") = 0 Then
XH = XH + 1
Set mybook = Application.Workbooks.Open(mypath & "\" & MYFILE)
Set mysheet = mybook.Sheets(1)
With mysheet
HH = .Cells(100000, 1).End(xlUp).Row
Range(.Cells(1, 1), .Cells(HH, 100)).Select
Selection.Copy
End With
Windows(myw).Activate
Sheets("原始数据合并").Select
Range("B" & ZZ).Select
ActiveSheet.Paste
Range(Cells(ZZ, 1), Cells(ZZ + HH - 1, 1)).Formula = XH
ZZ = ZZ + HH
mybook.Close
End If
MYFILE = Dir '第二次读入的时候不用写参数
Loop
Cells(1, 1) = "编号"
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub