Excel vba copy and paste the entire range with criteria?

Question

Thanks for reading my questions.

I have a table [ws1(A4:Q500)] contains data, while there are formula after column Q. Therefore I cannot copy the whole row but only certain range in text.

Column Q is the formula to define whether the data falls into period, ie 16/11-30/11 data. The flag is as follows:

0 < 16/11

1 = 16/11 - 30/11

2 > 30/11

Here the goal is to copy ws1 data with flag "1" to [ws2(A2:P200)] And then delete ws1 data with flag "1" and "2"

Believe that the rules for copying and deleting is quite similar, I tried to do the copy parts first

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

The debug functions said its wrong in

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

I tried hard to do modifications but it stills not work, please help me a bit :( Thanks so much.

Answer 1

The ws2.Range(Cells(j, 1), Cells(j, 16)).PasteSpecial does not adequately reference the range as belonging to ws2 . The Cells(...) within the range could belong to any worksheet; they have to specifically belong to ws2 . The same goes for 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

An AutoFilter Method may save you some time with a bulk value transfer.

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

I noticed you are using a Range.PasteSpecial method with xlPasteValues . If you require value-only transfer, then that can be accommodated.