用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