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

Question

我是 VBA 新手。我对变量数据使用一列数组。从第一个单元格（A1）开始，我想复制 A1 中的文本值，粘贴到 Sheet2，在 A5 中，返回到数组并重新执行此操作，直到找到一个空单元格。容易吧？

这是我的代码，我无法复制值并粘贴它。

谢谢你的建议！！！

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

您在使用宏记录器方面做出了很好的尝试。现在让我们清理一下：

1. 我将所有表格移动到变量中以限制输入量。

2. 我删除了所有的 .Select 和 .Activate，它们只会减慢代码速度，如果引用得当，它们就不需要了。

3. 当只需要值时，直接分配它们比使用剪贴板更快。我们可以将其作为一个单元块来完成。

4. 对于在原始工作表中找到的每一行，我使用计数器在目标工作表上向下移动一行。

代码：

  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