Excel vba是否使用条件复制并粘贴整个范围？

Question

谢谢你阅读我的问题。

我有一个表[ws1（A4:Q500）]包含数据，而Q列后面有公式。因此，我无法复制整行，只能复制文本中的特定范围。

Q列是定义数据是否属于周期的公式，即11月16日至11月30日的数据。标志如下：

0

1 = 16/11 - 30/11

2.

这里的目标是将带有标志“1”的ws1数据复制到[ws2（A2：P200）]，然后删除带有标志“1”和“2”的ws1数据

相信复制和删除的规则相当相似，我尝试先做复制部分

Sub PlotGraph()
Dim i As Integer
Dim j As Integer
Dim lastrow As Integer
Dim ws1 As Worksheet: Set ws1 = ThisWorkbook.Sheets("Data")
Dim ws2 As Worksheet: Set ws2 = ThisWorkbook.Sheets("Analysis")   

j = 2

lastrow = ws1.Cells(Rows.Count, 1).End(xlUp).Row
    
For i = 4 To lastrow

    If ws1.Cells(i, 17) = 1 Then
        ws1.Range(Cells(i, 1), Cells(i, 16)).Copy
        ws2.Range(Cells(j, 1), Cells(j, 16)).PasteSpecial Paste:=xlPasteValues, _
                            Operation:=xlNone, _
                            SkipBlanks:=True, _
                            Transpose:=False
     j = j + 1
End If
Next i

End Sub

调试函数说它是错误的

ws1.Range(Cells(i, 1), Cells(i, 16)).Copy

我努力做修改，但它仍然不起作用，请帮我一点：（非常感谢。

Answer 1

ws2. Range（Cells（j，1）， Cells（j，16））。PasteSpecial没有充分引用属于ws2的范围。范围内的Cells（...）可以属于任何工作表；它们必须专门属于ws2。ws1也是如此。

ws1.Range(ws1.Cells(i, 1), ws1.Cells(i, 16)).Copy
ws2.Range(ws2.Cells(j, 1), ws2.Cells(j, 16)).PasteSpecial Paste:=xlPasteValues, _
                        Operation:=xlNone, _
                        SkipBlanks:=True, _
                        Transpose:=False

自动过滤方法可以为批量值传输节省一些时间。

Sub PlotGraph()
    Dim i As Long, j As Long, lr As Long
    Dim ws1 As Worksheet
    Dim ws2 As Worksheet

    Set ws1 = ThisWorkbook.Sheets("Data")
    Set ws2 = ThisWorkbook.Sheets("Analysis")

    j = 2

    With ws1
        lr = .Cells(Rows.Count, 1).End(xlUp).Row

        With .Range(.Cells(3, 1), .Cells(lr, 17)) 'Range(A3:Q & lr) need header row for autofilter
            .AutoFilter field:=17, Criteria1:=1
            With .Resize(.Rows.Count - 1, 16).Offset(1, 0)
                If CBool(Application.Subtotal(103, .Cells)) Then
                    .Cells.Copy _
                      Destination:=ws2.Cells(j, 1)
                    'optional Copy/PasteSpecial xlPasteValues method
                    '.Cells.Copy
                    'ws2.Cells(j, 1).PasteSpecial Paste:=xlPasteValues
                    '▲ might want to locate row j properly instead of just calling it 2
                End If
            End With
        End With

    End With
End Sub

我注意到你正在使用一个范围。粘贴使用xlPasteValues的特殊方法。如果您需要仅值传输，那么这是可以接受的。