用vba生成工资存根

我有一张工作表，上面有一名员工的工资信息，包括税款扣除，我想有一个按钮，当点击时，会自动生成一个工资存根，其中包含给定周的所有相关信息

我能够以所需的格式生成新的工作表，但在从一张工作表到另一张工作表之间获取数据时遇到困难。例如，我需要1/10/16的行填充到预定的单元格中

---

我正在使用。

好的，首先，我假设您已经设置好了开发人员功能区。这是我为测试所做的快速简单的宏。此代码没有说明列表中不存在的日期，因此如果您认为这会有问题，则必须将其添加到列表中。我在工作表中使用了一个空格作为日期的输入，我们希望选择附加的屏幕截图，并确保单元格的格式与您的日期范围相同，通过更改此日期，它将更改复制的行。您设置的初始范围将是第一行，根据您的示例，这将是A6，currRow是该行的编号，所以是6。另外，If语句下面的行选择要复制的范围，如果它总是a到U，那么这很好，如果不是，您可以编辑U。在该行下，我有您要粘贴到的工作表Sheet2的名称，以及我要粘贴到的单元格A1

Sub CopyOver()

Sheets("Sheet1").Select
Range("A2").Select
currRow = 2

Do While True

    If Selection.Value = Sheets("Sheet1").Range("C1").Value Then
        Range("A" & currRow & ":" & "U" & currRow).Select
        Selection.Copy

        Sheets("Sheet2").Select
        Range("A1").Select
        ActiveSheet.Paste
        Application.CutCopyMode = False
        Exit Do
    Else
        ActiveCell.Offset(1).Select
        currRow = currRow + 1
    End If
Loop

End Sub

编写宏后，通过转到开发人员->插入->按钮窗体控件来创建按钮。然后，您可以在弹出窗口中将宏的名称指定给它，这一个称为CopyOver。然后，您可以通过选择按钮上的文本来重命名按钮。希望这有帮助

---

就是这样。。。但我想知道是否有办法或理由缩短它？ 我每周需要52个宏，除了每周制作一个宏之外，还有更好的方法吗

Sub JanuaryThird()


Dim strFilename As String
Dim dir As String

strFilename = ThisWorkbook.Sheets("Summary").Range("A3").Text
dir = ThisWorkbook.Path & "\Pay Stubs\"


Application.ScreenUpdating = False


'Open Pay Stub Template
    Workbooks.Open filename:= _
        ThisWorkbook.Path & "\PayStubTemplate.xlsx"


'Copy Name
    Windows("Pay Summary 2016.xlsm").Activate
    Sheets("Summary").Select
    Range("B1").Select
    Selection.Copy
'Paste Name
    Windows("PaystubTemplate.xlsx").Activate
    Sheets("PayStub").Select
    Range("A4").Select
    ActiveSheet.Paste Link:=True


'Copy Hours Worked
    Windows("Pay Summary 2016.xlsm").Activate
    Sheets("Summary").Select
    Range("D3").Select
    Selection.Copy
'Paste Hours Worked
    Windows("PaystubTemplate.xlsx").Activate
    Sheets("PayStub").Select
    Range("D4").Select
    ActiveSheet.Paste Link:=True


'Copy Pay Rate
    Windows("Pay Summary 2016.xlsm").Activate
    Sheets("Summary").Select
    Range("C3").Select
    Selection.Copy
'Paste Pay Rate
    Windows("PaystubTemplate.xlsx").Activate
    Sheets("PayStub").Select
    Range("F4").Select
    ActiveSheet.Paste Link:=True


'Copy Period End
    Windows("Pay Summary 2016.xlsm").Activate
    Sheets("Summary").Select
    Range("A3").Select
    Selection.Copy
'Paste Period End
    Windows("PaystubTemplate.xlsx").Activate
    Sheets("PayStub").Select
    Range("H4").Select
    ActiveSheet.Paste Link:=True


'Copy Check No.
    Windows("Pay Summary 2016.xlsm").Activate
    Sheets("Summary").Select
    Range("B3").Select
    Selection.Copy
'Paste Check No.
    Windows("PaystubTemplate.xlsx").Activate
    Sheets("PayStub").Select
    Range("J4").Select
    ActiveSheet.Paste Link:=True


'Copy Base YTD
    Windows("Pay Summary 2016.xlsm").Activate
    Sheets("Summary").Select
    Range("G3").Select
    Selection.Copy
'Paste Base YTD
    Windows("PaystubTemplate.xlsx").Activate
    Sheets("PayStub").Select
    Range("E7").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False


'Copy Overtime YTD
    Windows("Pay Summary 2016.xlsm").Activate
    Sheets("Summary").Select
    Range("H3").Select
    Selection.Copy
'Paste Overtime YTD
    Windows("PaystubTemplate.xlsx").Activate
    Sheets("PayStub").Select
    Range("E7").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False


'Copy Federal W/H
    Windows("Pay Summary 2016.xlsm").Activate
    Sheets("Summary").Select
    Range("L3").Select
    Selection.Copy
'Paste Federal W/H
    Windows("PaystubTemplate.xlsx").Activate
    Sheets("PayStub").Select
    Range("I7").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False


'Copy Federal W/H YTD
    Windows("Pay Summary 2016.xlsm").Activate
    Sheets("Summary").Select
    Range("M3").Select
    Selection.Copy
'Paste Federal W/H YTD
    Windows("PaystubTemplate.xlsx").Activate
    Sheets("PayStub").Select
    Range("K7").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False


'Copy SS YTD
    Windows("Pay Summary 2016.xlsm").Activate
    Sheets("Summary").Select
    Range("O3").Select
    Selection.Copy
'Paste SS YTD
    Windows("PaystubTemplate.xlsx").Activate
    Sheets("PayStub").Select
    Range("K8").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False


'Copy Medicare YTD
    Windows("Pay Summary 2016.xlsm").Activate
    Sheets("Summary").Select
    Range("Q3").Select
    Selection.Copy
'Paste Medicare YTD
    Windows("PaystubTemplate.xlsx").Activate
    Sheets("PayStub").Select
    Range("K9").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False


'Copy L&I YTD
    Windows("Pay Summary 2016.xlsm").Activate
    Sheets("Summary").Select
    Range("S3").Select
    Selection.Copy
'Paste L&I YTD
    Windows("PaystubTemplate.xlsx").Activate
    Sheets("PayStub").Select
    Range("K10").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False


'Copy Gross Earnings YTD
    Windows("Pay Summary 2016.xlsm").Activate
    Sheets("Summary").Select
    Range("J3").Select
    Selection.Copy
'Paste Gross Earnings YTD
    Windows("PaystubTemplate.xlsx").Activate
    Sheets("PayStub").Select
    Range("E14").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False


'Copy Net Earnings YTD
    Windows("Pay Summary 2016.xlsm").Activate
    Sheets("Summary").Select
    Range("W3").Select
    Selection.Copy
'Paste Net Earnings YTD
    Windows("PaystubTemplate.xlsx").Activate
    Sheets("PayStub").Select
    Range("E15").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False


'Save as PDF
    Workbooks("PaystubTemplate.xlsx").ExportAsFixedFormat _
    Type:=xlTypePDF, _
    filename:=dir & strFilename, _
    Quality:=xlQualityStandard, _
    IncludeDocProperties:=True, _
    IgnorePrintAreas:=False, _
    OpenAfterPublish:=False


'Close Template
    Workbooks("PaystubTemplate.xlsx").Close False


Application.ScreenUpdating = False

End Sub

---

感谢@Mykola编辑我的问题。这是我贴出的第一个编码问题：@Mykola:没关系，这个代码不会填充特定的单元格，只会填充整行。。。表单控件按钮的建议非常有用，尽管52个ActiveX按钮并不是一个好主意，但我在漫长的道路上发现了这一点：