Excel VBA复制并粘贴整个范围与条件？

Question

感谢您阅读我的问题。

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

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

0 <16/11

1 = 16/11-30/11

2> 30/11

这里的目标是将带有标志“ 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的Range.PasteSpecial方法 。 如果您需要仅值转移，则可以接受。