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

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

这是我拥有的代码，我无法复制该值并将其粘贴。

谢谢您的建议！！！

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

最佳答案

您已经使用宏录制器进行了很大的尝试。现在让我们清理一下：


我将所有工作表移到变量中以限制键入量。
我删除了所有.Select和.Activate，它们只会减慢代码速度，并且如果引用正确，则不需要它们。
如果只需要值，则直接分配它们比使用剪贴板更快。我们可以将其作为一个单元格来完成。
我使用一个计数器将目标表中的每一行向下移动到原始表中的每一行。


代码：

  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

关于excel - 简单的数组循环复制和粘贴，我们在Stack Overflow上找到一个类似的问题：https://stackoverflow.com/questions/37375878/