循环将表格数据复制到1个单元格中，然后将结果复制并粘贴到另一个表格中

下面，我有代码将从单元格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中，我有input单元格用于放置人员姓名的位置，而在F3中我有一个返回附加到人员名称的值的查找。

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