用vba生成工资存根

Question

我有一张工作表，其中有一名员工带薪酬信息，包括税收减免，并且我想要一个按钮，单击它时会自动生成一个包含给定周的所有相关信息的工资单。

我可以生成所需格式的新工作表，但我无法从一张表格获取数据到另一张表格。我需要，例如，1/10/16的row填充到预定的单元格中。

This is a sample of the worksheet我正在使用。

Answer 1

首先确定事情的第一件事，我假设您已经设置了开发人员功能区。这是我为测试所做的快速而简单的宏。本代码不会列入清单中不存在的日期，因此如果您认为这将是一个问题，那么您必须补充说明。我在工作表中使用了一个空格作为我们想要选择的日期的“输入”（附加了屏幕截图并确保单元格的格式与您的日期范围相同），通过更改此日期，它将更改这一行被复制。你设置的初始范围将是带日期的第一行（根据你的例子，这将是“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 

写好宏之后，通过转到Developer-> Insert-> Button（Form Control）来创建按钮。然后，您可以在弹出窗口中为其指定宏的名称（这个名称为“CopyOver”）。然后，您可以通过选择其中的文本来重命名按钮。希望这有助于！

Sheet1 Sheet2

Answer 2

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