Merge Files by Pagebreak

Question

I want to write a program that merges two files by page break. For example if I had two files A and B, which each had 3 page breaks I want to create a new file by copying all data in file A before page break 1, than all data in file B before page break 1, than all data in file A between page break 1 and page break 2, than all data in file B between page break 1 and page break 2, etc.

I have the following code which simply opens the two files and than copies the data from file A and than the data from file B. I cannot figure out how to change the code to merge the two loops so that the new file will copy all data in file A before page break 1, than all data in file B before page break 1, etc.

Any help would be really appreciated! Thank you!

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

Answer 1

The procedure below merges all print pages from the first worksheet of two workbooks

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