Question

我有一张工作表，其中有一名员工有工资信息，包括税收减免，我希望有一个按钮，当点击时，会自动生成一个包含给定周的所有相关信息的工资存根。

我能够以所需的格式生成新工作表，但是我无法将数据从一个工作表传输到另一个工作表。例如，我需要row 1/10/16填充到预定的单元格中。

This is a sample of the worksheet我正在与之合作。

Answer 1

这就是它！ ......但我想知道是否有办法或理由缩短它？而且由于我每周需要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

Answer 2

好的，首先，我假设您已经设置了开发人员功能区。这是我为测试做的快速简便的宏。这个代码已经存在并且已经存在于该列表中的日期，所以如果您认为这将是一个问题，那么您需要添加该帐户。我在表单中使用了一个空格作为＆＃34;输入＆＃34;对于我们想要选择的日期（附加屏幕截图并确保单元格的格式与日期范围相同），通过更改此日期，它将更改复制的行。您设置的初始范围将是带有日期的第一行（根据您的示例，这将是＆＃34; A6和＃34;），而currRow是该行号（因此为6）。此外，If语句下面的行是选择要复制的范围，如果它总是A到U那么这很好，如果不是，你可以编辑＆＃34; U＆＃34;。在那之下，我有要粘贴的工作表（＆＃34; Sheet2＆＃34;）的名称，以及我要粘贴到的单元格（＆＃34; A1＆＃34;）。

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

写完宏后，转到Developer-＆gt; Insert-＆gt; Button（Form Control）创建按钮。然后你可以在弹出窗口中为它指定宏的名称（这个叫做＆＃34; CopyOver＆＃34;）。然后，您可以通过选择其上的文本来重命名按钮。希望这有帮助！

Sheet1 Sheet2

使用vba生成工资存根

2 个答案: