工资条批量生成

从工资总表批量生成工资条

Sub GeneratePaySlips()
    Dim sourceWS As Worksheet
    Dim targetWS As Worksheet
    Dim lastRow As Long
    Dim i As Long
    Dim colCount As Integer

    Set sourceWS = ThisWorkbook.Sheets("工资总表")
    Set targetWS = ThisWorkbook.Sheets("工资条")

    lastRow = sourceWS.Cells(Rows.Count, 1).End(xlUp).Row
    colCount = sourceWS.Cells(2, Columns.Count).End(xlToLeft).Column

    For i = 3 To lastRow
        targetRow = (i - 2) * 5 - 2
        sourceWS.Range(sourceWS.Cells(2, 1), sourceWS.Cells(2, colCount)).Copy
        targetWS.Cells(targetRow, 1).PasteSpecial Paste:=xlPasteAll
        sourceWS.Range(sourceWS.Cells(i, 1), sourceWS.Cells(i, colCount)).Copy
        targetWS.Cells(targetRow + 1, 1).PasteSpecial Paste:=xlPasteValues
    Next

    MsgBox "共生成 " & (lastRow - 2) & " 份工资条！"
End Sub