VBA代码:合并目录下所有Excel文件(xls/xlsx)并自定义表头行数
Sub MergeExcelFiles() Dim path As String, fileName As String, sheetName As String Dim totalRows As Integer, headerRows As Integer Dim i As Integer, j As Integer, k As Integer Dim wb As Workbook, wbNew As Workbook Dim ws As Worksheet, wsNew As Worksheet Dim rng As Range
path = Application.ActiveWorkbook.Path & "\"
fileName = Dir(path & "*.xls*")
sheetName = "Sheet1"
headerRows = 3 '自定义表头行数
Set wbNew = Workbooks.Add
Set wsNew = wbNew.Sheets(sheetName)
Do While fileName <> ""
If InStr(fileName, "~$") = 0 Then
Set wb = Workbooks.Open(path & fileName)
For Each ws In wb.Worksheets
totalRows = ws.Range("A" & ws.Rows.Count).End(xlUp).Row
Set rng = ws.Range("A" & headerRows & ":IV" & totalRows)
rng.Copy wsNew.Range("A" & wsNew.Range("A" & wsNew.Rows.Count).End(xlUp).Row + 1)
Next ws
wb.Close
End If
fileName = Dir()
Loop
wsNew.Columns.AutoFit
MsgBox "合并完成!"
End Sub
原文地址: http://www.cveoy.top/t/topic/nUVB 著作权归作者所有。请勿转载和采集!