Question

我想编写一个程序，通过分页符合并两个文件。例如，如果我有两个文件A和B，每个文件有3个分页符，我想通过在分页符1之前复制文件A中的所有数据来创建新文件，而不是所有数据，而不是在分页符1之前的文件B中的所有数据在分页符1和分页符2之间的文件A中，而不是分页符1和分页符2之间的文件B中的所有数据等。

我有以下代码，只打开两个文件，然后复制文件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

Answer 1

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

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

通过Pagebreak合并文件

1 个答案: