|
“里面有三个文件名分别为1,2,3”,这个文件夹新建一个工作簿运行代码,运行完这个目录会有一个“汇总.xlsx”,所有汇总都在里面,试试看
Sub kong()
Dim xp, myPath, myFile
Dim wb As Workbook, wk As Workbook
Set wb = ThisWorkbook
Dim ar() As String
Dim k
k = 0
On Error Resume Next
'定义对话框变量
Application.ScreenUpdating = False
Application.DisplayAlerts = False
xp = ThisWorkbook.Path
myPath = xp & "\*.xls*"
myFile = Dir(myPath)
If myFile <> ThisWorkbook.Name Then '如果不是本文件,取出放入数组(2019年2月28日修改)
ReDim Preserve ar(k) '不清空数组
ar(k) = myFile
k = k + 1
End If
Do While myFile <> ""
myFile = Dir
If myFile = ThisWorkbook.Name Then
myFile = Dir
End If
If myFile = "" Then
Exit Do
End If
ReDim Preserve ar(k) '不清空数组
ar(k) = myFile
k = k + 1
Loop
Dim b
'合并成一个文件名为“汇总”的总表
b = ThisWorkbook.Path & "/" & "汇总.xlsx"
Workbooks.Add.SaveAs b, FileFormat:=51
Set wk = ActiveWorkbook
wk.Worksheets.Add(after:=wk.Worksheets(wk.Worksheets.Count)).Name = "汇总"
Dim i, a, a1
i = 0
a = 0
a1 = 1
Do While i < k
Set wt = Workbooks.Open(xp & "\" & ar(i))
wt.Activate
a = wt.Worksheets("sheet1").Cells(Rows.Count, "e").End(3).Row
'从 e1 开始复制,这个可以自行选择
wt.Worksheets("sheet1").Range("e1" & ":e" & a).Select
Selection.Copy
wk.Activate
wk.Worksheets("汇总").Cells(1, a1).Select
wk.Worksheets("汇总").Paste
wt.Close , flase
a1 = a1 + 1
i = i + 1
a = 0
Loop
Application.DisplayAlerts = False
wk.Sheets("sheet1").Delete
Application.DisplayAlerts = True
wk.Activate
wk.Close True
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub
|
|