首页 > 解决方案 > VBA复制粘贴突然重复粘贴

问题描述

我已经运行这个脚本一段时间了,没有问题,然后今天它坏了。这是非常基本的,因为我只是从一个选项卡中过滤值,然后将它们复制并粘贴到顶行的另一个选项卡上。但是突然之间,它会粘贴这些值,然后重复粘贴这些值 19 次,总共复制粘贴 20 次。

Sheets("BSLOG").Select
Range("Q1").Select
Selection.AutoFilter Field:=17, Criteria1:="1"
Range("A1:Q5000").Select
Range("A1:Q5000").Activate
Selection.Copy
Sheets("PENDG TRADES").Select
Range("A1:Q300").Select
ActiveSheet.Paste

标签: excelvbacopy-paste

解决方案


FaneDuru 是对的。你也可以试试这个代码,我更喜欢它:

Option Base 1 'This means all array starts at 1. It is set by default at 0. Use whatever you prefer,depending if you have headers or not, etc
Sub TestFilter()
Dim shBSLOG As Worksheet
Dim shPENDG As Worksheet
Dim rngBSLOG As Range
Dim arrBSLOG(), arrCopy()
Dim RowsInBSLOG&
Dim i&, j&, k&

Set shBSLOG = Worksheets("BSLOG")
Set shPENDG = Worksheets("PENDG TRADES")

With shBSLOG
    Set rngBSLOG = .Range(.Cells(1, 1), .Cells(5000, 17))
End With
    RowsInBSLOG = rngBSLOG.Rows.Count
    arrBSLOG = rngBSLOG
    
    ReDim arrCopy(1 To RowsInBSLOG, 1 To 17) 'set the size of the new array as the original array
    
k = 1 'k is set to 1. This will be used to the row of the new array "arrCopy"
For i = 1 To RowsInBSLOG 'filter the array. From the row "i" = 1 to the total of rows "RowsinBSLOG
    If arrBSLOG(i, 1) = 1 Then 'if the first column of the row i is equal to 1, then...
        For j = 1 To 17
            arrCopy(k, j) = arrBSLOG(i, j) 'copy the row
        Next j
        k = k + 1 'next copy will be in a new row
    End If
Next i 'repeat

With shPENDG
    .Range(.Cells(1, 1), .Cells(k, 17)) = arrCopy() 'place the new array in the new sheet

End With

End Sub

推荐阅读