[VBA] Excel表快速合并,多个Excel表合并到一个里面,只保留一个表头

修改了这片文章中提供的代码https://blog.csdn.net/shuai9201/article/details/73322974以实现合并的结果只有一个表头的功能。

Sub MergeMultiFiles()
    Dim filePath As String, fileName As String, mergedWorkbookName As String, processedFileNames As String
    Dim workbook As workbook
    Dim copyRange As Range
    Dim i As LongPtr
    Dim num As LongPtr
    Dim box As String
	Dim headerCount As Integer
    
	headerCount = 2 ' 表头行数,根据实际情况设置
    Application.ScreenUpdating = False
    filePath = ThisWorkbook.Path
    fileName = Dir(filePath & "\" & "*.xlsx")
    mergedWorkbookName = ThisWorkbook.Name
    num = 0
    
    Do While fileName <> ""
        If fileName <> mergedWorkbookName Then
            Set workbook = Workbooks.Open(filePath & "\" & fileName)
            num = num + 1
            With ThisWorkbook.ActiveSheet
                ' .Cells(.Range("A65535").End(xlUp).Row + 2, 1).Value = Left(fileName, Len(fileName) - 5)
                For i = 1 To workbook.Sheets.Count
                    If num = 1 and i = 1 Then
                        workbook.Sheets(i).UsedRange.Copy .Cells(1, 1)
                    Else
                        Set copyRange = workbook.Sheets(i).UsedRange
                        copyRange.Offset(headerCount, 0).Resize(copyRange.Rows.Count-headerCount, copyRange.Columns.Count).Copy .Cells(.Range("A65535").End(xlUp).Row + 1, 1)
                    End If
                Next
            End With
            processedFileNames = processedFileNames & Chr(13) & workbook.Name
            workbook.Close False
        End If
        fileName = Dir()
    Loop
    UsedRange.Columns.AutoFit
    Range("A1").Select
    Application.ScreenUpdating = True
    MsgBox "共合并了" & num & "个工作薄下的全部工作表。文件名如下:" & processedFileNames, vbInformation, "提示"
End Sub

你可能感兴趣的:(Excel,VBA)