VBA代码将单元格从sheet_A复制到sheet_B

Question

我有两张纸：

SheetA列出了员工编号。

表格B具有需要填写的表格，并在表格上印有每个员工的编号（然后，vlookup公式将填写其余表格）

现在，我可以手动复制粘贴每个员工ID，但是有330多名员工，这有点太多了。

我想复制Sheet_A中的单元格A2，将其粘贴到单元格A2 Sheet_B中并打印表格，然后转到Sheet_A中的单元格A3，将其复制，粘贴到Sheet_B中的A2中，依此类推...我想重复此过程337次。

我创建了此宏，但我不知道如何使它始终选择Sheet_A中的下一个单元格并重复337次。 （或取决于我们在特定时间有多少员工）

Sub Copy_Cell()
' Copy_Cell Macro

    Sheets("Sheet A").Select
    Range("A2").Select
    Selection.Copy
    Sheets("Sheet B").Select
    Range("A2").Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
    ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True, _
        IgnorePrintAreas:=False
End Sub

Answer 1

您只需要遍历每一行：

Sub Copy_Cell()
    Dim r As Long
    'Use a "With" block to save having to constantly type "Worksheets("Sheet A")"
    'inside the block
    With Worksheets("Sheet A")
        'Loop through all values in column A, thus saving the trouble of 
        'hard-coding the last row number to be used
        For r = 2 To .Cells(.Rows.Count, "A").End(xlUp).Row
            'Just copy the value directly from one worksheet to another, thus
            'avoiding copy/paste
            Worksheets("Sheet B").Range("A2").Value = .Cells(r, "A").Value
            Worksheets("Sheet B").PrintOut Copies:=1, _
                                           Collate:=True, _
                                           IgnorePrintAreas:=False
        Next r
    End With
End Sub

Answer 2

    Sub Copy_Cell() ' Copy_Cell Macro

Dim i as Integer
For i = 1 To 337
    Sheets("Sheet A").Activate
    ActiveSheet.Cells(i + 1, 1).Select
    Selection.Copy
    Sheets("Sheet B").Activate
    Range("A2").Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
    ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True, _
        IgnorePrintAreas:=False
Next i
    End Sub Image Image

Answer 3

Sub Copy_Cell()
    Dim row as Integer
    Do While row <= 337
        Sheets("Sheet A").Activate
        Sheets("Sheet A").Cells(row + 1, 1).Copy
        Sheets("Sheet B").Activate 
        Range("A2").Select
        ActiveSheet.Paste 
        ActiveWindow.SelectedSheets.PrintOut Copies:=1
        row = row + 1
    Loop
End sub