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

VBA代码:合并目录下所有Excel文件(xls/xlsx)并自定义表头行数

原文地址: http://www.cveoy.top/t/topic/nUVB 著作权归作者所有。请勿转载和采集!

免费AI点我,无需注册和登录