简单的数组循环复制和粘贴

我是VBA新手。 我使用一个列数组作为variables数据。 从第一个单元格（A1）开始，我想复制A1中的文本值，粘贴到Sheet2，在A5中，返回到数组，然后重新执行，直到到达空单元格。 容易吗？

这里是我有的代码，我不能复制值并粘贴它。

谢谢你的build议！！！

Sub copylist() ' copylist Macro Worksheets("ID nbr").Select Range("B3").Select For Each c In Worksheets("ID nbr").Range("B3:B20").Cells If c.Value <> "" Then Sheets("ID nbr").Select Dim rgCopy As Range Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _ False, Transpose:=False Range("B4:G4").Select Application.CutCopyMode = False Selection.Copy Sheets("Findings").Select Range("B4").Select Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _ False, Transpose:=False End If Next End Sub 

Answer 1

你用macroslogging器做了很大的尝试。 现在让我们来清理它：

1. 我把所有的表格都放到了variables中，以限制打字量。

2. 我删除了所有.Select和.Activate，这些只是减慢代码，如果正确引用，他们不需要。

3. 当只需要值时，直接赋值比使用剪贴板更快。 我们可以做到这一块的细胞。

4. 我使用了一个计数器在原始工作表中find的每一行在目标工作表上向下移动一行。

代码：

  Sub copylist() Dim ows As Worksheet Dim tws As Worksheet Dim c As Range Dim i As Long Set ows = Sheets("ID nbr") 'Original sheet Set tws = Sheets("Findings") 'Target sheet i = 4 'this is the first row in the target sheet With ows For Each c In .Range("B3:B20").Cells If c.Value <> "" Then tws.Range(tws.Cells(i, "B"), tws.Cells(i, "G")).Value = .Range(.Cells(c.Row, "B"), .Cells(c.Row, "G")).Value i = i + 1 End If Next c End With End Sub