简单的阵列循环复制和粘贴

时间:2016-05-22 14:57:14

标签: excel excel-vba vba

我是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

1 个答案:

答案 0 :(得分:2)

您使用宏录制器做了很多尝试。现在让我们清理一下:

  1. 我将所有工作表移动到变量中以限制输入的数量。

  2. 我删除了所有.Select和.Activate,这些只会减慢代码速度,如果正确引用则不需要它们。

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

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

  5. 代码:

      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