循環將表數據復制到1個單元格中，然后將結果復制並粘貼到另一個表中

Question

下面，我有代碼將數據從單元格E3復制到F3到H列中的下一個空單元格中。

Private Sub CommandButton1_Click()

    Application.ScreenUpdating = False

    Dim copySheet As Worksheet
    Dim pasteSheet As Worksheet

    Set copySheet = Worksheets("Sheet1")

    copySheet.Range("e3:f3").Copy
    copySheet.Cells(Rows.Count, 8).End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues

    Application.CutCopyMode = False
    Application.ScreenUpdating = True

End Sub

我的工作表的設置方法如下：

1）我的數據存儲在單元格B3至C7中

Person | Value
Alan   |   1
Dave   |   4
Fred   |   5
Perry  |   6
Ted    |   2

2）在單元格E3中，我有輸入單元格，用於輸入人名；在F3中，我有一個vlookup，它返回附加在人名上的值。

3）我需要做的是，我需要代碼從單元格B3到B7遍歷人員名稱，直到到達空白單元格，因此首先將單元格B3中的人員名稱放入單元格E3，然后將此數據從單元格E3：F3復制到另一個表中。

4）我應該得出的是我在第一個數據表中擁有的數據的克隆。 我正在工作的實際excel工作表比這要復雜一些，但是如果我能獲得執行此操作的代碼，它將為我提供一個基礎。

任何幫助將非常感激！

Answer 1

這是一個大綱循環，可以幫助您入門。 我不清楚所有內容都在哪里，因此工作表可能不正確。

Private Sub CommandButton1_Click()

Application.ScreenUpdating = False

Dim copySheet As Worksheet
Dim pasteSheet As Worksheet
Dim r As Range

Set copySheet = Worksheets("Sheet1")

With copySheet
    For Each r In .Range("B3", .Range("B" & Rows.Count).End(xlUp))
        If Len(r) > 0 Then
            .Range("E3").Value = r.Value
            .Range("E3").Resize(, 2).Copy
            .Cells(Rows.Count, 8).End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
        End If
    Next r
End With

Application.CutCopyMode = False
Application.ScreenUpdating = True

End Sub