Excel vba使用条件复制并粘贴整个范围?

时间:2015-12-03 08:46:34

标签: excel vba excel-vba

感谢您阅读我的问题。

我有一个表[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)] 然后使用flag" 1"删除ws1数据。和" 2"

相信复制和删除的规则非常相似,我试图先复制部分

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

我努力做了修改,但它仍然不起作用,请帮助我一点:(非常感谢。

1 个答案:

答案 0 :(得分:0)

ws2.Range(Cells(j, 1), Cells(j, 16)).PasteSpecial未充分引用属于ws2的范围。范围内的Cells(...)可以属于任何工作表;他们必须具体属于ws2ws1也是如此。

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

使用批量值转移AutoFilter Method可以为您节省一些时间。

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

我注意到您使用Range.PasteSpecial method xlPasteValues。如果您需要仅限价值的转账,那么可以接受。