20180429 xlVBA套打单据批量复制

Sub testCopyModelRange()
    Set ModelSheet = ThisWorkbook.Worksheets("单据模板")
    Set PrintSheet = ThisWorkbook.Worksheets("批量打印")
    CopyModelRange ModelSheet, PrintSheet, 2
End Sub
Public Sub CopyModelRange(ByVal ModelSheet As Worksheet, ByVal PrintSheet As Worksheet, ByVal CopyTime As Long)
    Dim ModelRng As Range '模板单元格
    Dim modelRowHeight() As Double '模板行高数据
    Dim desRng As Range '粘贴位置
    Dim i As Long '行号

    With ModelSheet
        If Application.WorksheetFunction.Count(.Cells) > 0 Then
            '计数防止计算行号发生错误
            EndRow = .Cells.Find("*", .Cells(1, 1), xlValues, xlWhole, xlByRows, xlPrevious).Row + 1
            EndCol = .Cells.Find("*", .Cells(1, 1), xlValues, xlWhole, xlByColumns, xlPrevious).Column
            '获取单据模板单元格区域
            Set ModelRng = .Range(.Cells(1, 1), .Cells(EndRow, EndCol))
            Debug.Print ModelRng.Address
        Else
            MsgBox "模板为空!"
            Exit Sub
        End If
    End With

    With PrintSheet
        .Cells.Clear
        '批量复制单据模板
        For i = 1 To CopyTime
            If Application.WorksheetFunction.Count(.Cells) = 0 Then
                Set desRng = .Range("A1")
            Else
                EndRow = .Cells.Find("*", .Cells(1, 1), xlValues, xlWhole, xlByRows, xlPrevious).Row + 2
                Set desRng = .Cells(EndRow, 1)
            End If
            ModelRng.Copy desRng
        Next i
    End With

End Sub