请教一下如何合并指定文件夹的所有excel文件,每个excel文件数据不等
比如文件夹里有三个文件
每个文件的表头一样,下图仅为示例:
要合并成下面这样
录制一个宏,记录下你打开文件,选中,复制,粘贴的步骤,基本就有了
然后再加上一个获取指定文件夹下文件的方法,取得文件列表,循环一下就成了
Sub Dan()
' 主程序
Dim filepaths$
Dim a, arrfile, Arr
Dim Wkb As Workbook, Sht As Worksheet
Dim theWkb As Workbook, theSht As Worksheet
Dim endRow%, i%, j%
Call deleteAllOthers
filepaths = getCurFiles()
arrfile = Split(filepaths, "|")
Set theWkb = ThisWorkbook
Set theSht = Sheet1
For Each a In arrfile
Set Wkb = Workbooks.Open(a)
For Each Sht In Wkb.Sheets
If Sht.Name = "目录" Or Sht.Name = "汇总" Then
Arr = Sht.UsedRange
With theSht
For i = 3 To UBound(Arr)
If Len(Arr(i, 1)) > 0 Then
endRow = .Cells(.Rows.Count, 1).End(3).Row + 1
For j = LBound(Arr, 2) To 6
.Cells(endRow, j).Value = Arr(i, j)
Next
End If
Next
End With
Else
Sht.Copy after:=theSht
End If
Next
Wkb.Close 0
Next
End Sub
Function getCurFiles() As String()
' 获取当前文件夹所有文件
Dim Folder$, Filename$, Filepath$, filepaths(), arrCount%
Folder = "D:\OneDrive\桌面\隽悦雅苑\"
Filename = Dir(Folder)
While Filename <> ""
If Filename <> ThisWorkbook.Name Then
ReDim Preserve filepaths(0 To arrCount)
Filepath = Folder + Filename
filepaths(arrCount) = Filepath
arrCount = arrCount + 1
End If
Filename = Dir
Wend
getCurFiles = Join(filepaths, "|")
End Function
Sub deleteAllOthers()
' 在当前工作簿删除除了汇总以外的所有其他表
Dim Sht As Worksheet
On Error Resume Next
For Each Sht In ThisWorkbook.Sheets
If Sht.Name <> Sheet1.Name Then
Sht.Delete
End If
Next
Debug.Print "All Deleted"
End Sub
Sub test()
x = getCurFiles
Debug.Print x
End Sub