Excel 按分页符合并文件

我想写一个程序，通过分页符合并两个文件。例如，如果我有两个文件A和B，每个文件都有3个分页符，我想通过复制文件A中分页符1之前的所有数据、文件B中分页符1之前的所有数据、文件A中分页符1和分页符2之间的所有数据、文件B中分页符1和分页符2之间的所有数据来创建一个新文件，以此类推

我有以下代码，它只是打开两个文件，然后从文件A复制数据，然后从文件B复制数据。我不知道如何更改代码以合并两个循环，以便新文件将在分页符1之前复制文件A中的所有数据，而不是在分页符1之前复制文件B中的所有数据，等等

任何帮助都将不胜感激！谢谢大家!

Sub Merge_Mchpg()
'Open two workbooks
Workbooks.Open (Workbooks("Filepath.xlsx")
Workbooks.Open (Workbooks("Filepath.xlsx"))


Dim pgBreak As Variant 
Dim pgBreak2 As Variant 

Dim pgbrk1 As Integer 'Define variable for first worksheet pagebreaks
pgbrk1 = 1
Dim pgbrk2 As Integer 'Define variable for second worksheet pagebreaks
Dim SourceRange As Range 'Define the source range in the newworkbook
pgbrk2 = 1
Dim pgbrkAll As Integer 'Integer to keep track of location in new wkbk
pgbrkAll = 1
Workbooks.Add 'Create new summary workbook
Dim rowDiff As Integer 'Integer to keep track of location in new wkbk
For Each pgBreak In Workbooks("test1.xlsx").Worksheets("Sheet1").HPageBreaks

    Set SourceRange = Workbooks("test1.xlsx").Worksheets("Sheet1").Range("A" & pgbrk1, "K" & pgBreak.Location.Row - 1)
    SourceRange.Copy
    ActiveSheet.Range("A" & pgbrkAll).PasteSpecial
    rowDiff = pgBreak.Location.Row - pgbrk1

   pgbrk1 = pgBreak.Location.Row
   pgbrkAll = pgbrkAll + rowDiff + 1
  Next

For Each pgBreak2 In` Workbooks("test2.xlsx").Worksheets("Sheet1").HPageBreaks
            Set SourceRange = Workbooks("test2.xlsx").Worksheets("Sheet1").Range("A" & pgbrk2, "K" & pgBreak2.Location.Row - 1)
           SourceRange.Copy
            ActiveSheet.Range("A" & pgbrkAll).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, _
            SkipBlanks:=False, Transpose:=False
             rowDiff = pgBreak2.Location.Row - pgbrk2

             pgbrk2 = pgBreak2.Location.Row

            pgbrkAll = pgbrkAll + rowDiff + 1

   Next


End Sub

---

以下过程合并两个工作簿中第一个工作表中的所有打印页

Sub Wsh_MergeWshByPageBreak()
Const kCol As Byte = 11 'Last column of the range to merge (11 for K)

Rem Variant to hold the fullname of the files to merged
Dim aWbkName As Variant
aWbkName = Array(kFile1, kFile2)

Dim WshSrc(2) As Worksheet, RwSrcIni(2) As Long
Dim WshTrg As Worksheet, RwTrgIni As Long
Dim PgBreak As HPageBreak
Dim SrcRng As Range
Dim PgBrkMax As Integer
Dim i As Integer
Dim b As Byte

    Rem Set worksheet to hold the merge in a new workbook
    RwTrgIni = 1
    Set WshTrg = Workbooks.Add.Worksheets(1)

    Rem Set Source worksheets
    PgBrkMax = 0
    For b = 1 To 2
        RwSrcIni(b) = 1
        Set WshSrc(b) = Workbooks.Open(kPath & aWbkName(b)).Worksheets(1)
        If WshSrc(b).HPageBreaks.Count > PgBrkMax Then PgBrkMax = WshSrc(b).HPageBreaks.Count
    Next

    Rem Merge Worksheets PrintArea by Page
    For i = 1 To PgBrkMax
        For b = 1 To 2
            Set PgBreak = Nothing
            On Error Resume Next
            Set PgBreak = WshSrc(b).HPageBreaks(i)
            On Error GoTo 0

            If Not (PgBreak Is Nothing) Then
                With WshSrc(b)
                    Set SrcRng = Range(.Cells(RwSrcIni(b), 1), .Cells(-1 + PgBreak.Location.Row, kCol))
                    SrcRng.Copy
                    WshTrg.Cells(RwTrgIni, 1).PasteSpecial Paste:=xlPasteValues
                    RwSrcIni(b) = PgBreak.Location.Row
                    RwTrgIni = 1 + RwTrgIni + SrcRng.Rows.Count

    End With: End If: Next: Next

End Sub

---

我会用一个公共索引替换每个循环的

，比如I=1到.HPageBreaks.Count的
，然后在每次迭代中通过
.HPageBreaks（I）
组合每个工作簿中的每个范围。您只需确保每个工作簿都有足够的分页符来继续。如果您想对每种方法使用
，您需要记住电子表格中需要插入的行。您可以在第一张工作表的分页符中保留一个数组，然后在第二张工作表的这些行中为每个
插入一个数组。