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