Copy multiple rows from selected columns if condition met

Question

Illustration:
I have 2 sheets: ShNote = reference table & ShPPT = final table.
I have 4 different tables inside the sheet final table.

What I am looking for: (4 conditions)

Find value = 20 in column E and copy paste the value and only client's name on column A to final table's sheet on 1st table (C:D)
Find value greater than 17 but less than 20 and copy paste the value and only client's name on column A to final table's sheet on 2nd table (F:G)
Find value greater than 15 but less than 17 and copy paste the value and only client's name on column A to final table's sheet on 3rd table (I:J)
Find value greater than 11 less than 15 and copy paste the value and only client's name on column A to final table's sheet on last table (L:M)

I just updated my code and it works well

Option Explicit

Sub Analysis_ClientRating()

Dim lastrow As Long, i As Long, rowppt As Long, colppt As Long Dim rowppt1 As Long, colppt1 As Long, rowppt2 As Long, colppt2 As Long Dim rowppt3 As Long, colppt3 As Long

lastrow = ShNote.Range("C" & Rows.Count).End(xlUp).Row
rowppt = ShPPT.Cells(Rows.Count, 1).End(xlUp).Row
colppt = ShPPT.Cells(Rows.Count, 1).End(xlUp).Row
rowppt1 = ShPPT.Cells(Rows.Count, 1).End(xlUp).Row
colppt1 = ShPPT.Cells(Rows.Count, 1).End(xlUp).Row
rowppt2 = ShPPT.Cells(Rows.Count, 1).End(xlUp).Row
colppt2 = ShPPT.Cells(Rows.Count, 1).End(xlUp).Row
rowppt3 = ShPPT.Cells(Rows.Count, 1).End(xlUp).Row
colppt3 = ShPPT.Cells(Rows.Count, 1).End(xlUp).Row

Call Entry_Point

For i = 6 To lastrow
    Select Case ShNote.Cells(i, 5).Value
        Case Is = 20
        ShNote.Cells(i, 3).Copy
        ShPPT.Cells(rowppt + 6, 3).PasteSpecial xlPasteValues
        ShNote.Cells(i, 5).Copy
        ShPPT.Cells(colppt + 6, 4).PasteSpecial xlPasteValues
        rowppt = rowppt + 1
        colppt = colppt + 1

        Case Is >= 17
        ShNote.Cells(i, 3).Copy
        ShPPT.Cells(rowppt1 + 6, 6).PasteSpecial xlPasteValues
        ShNote.Cells(i, 5).Copy
        ShPPT.Cells(colppt1 + 6, 7).PasteSpecial xlPasteValues
        rowppt1 = rowppt1 + 1
        colppt1 = colppt1 + 1

        Case Is >= 15
        ShNote.Cells(i, 3).Copy
        ShPPT.Cells(rowppt2 + 6, 9).PasteSpecial xlPasteValues
        ShNote.Cells(i, 5).Copy
        ShPPT.Cells(colppt2 + 6, 10).PasteSpecial xlPasteValues
        rowppt2 = rowppt2 + 1
        colppt2 = colppt2 + 1

        Case Is >= 11
        ShNote.Cells(i, 3).Copy
        ShPPT.Cells(rowppt3 + 6, 12).PasteSpecial xlPasteValues
        ShNote.Cells(i, 5).Copy
        ShPPT.Cells(colppt3 + 6, 13).PasteSpecial xlPasteValues
        rowppt3 = rowppt3 + 1
        colppt3 = colppt3 + 1


    End Select
Next i

Call Exit_Point End Sub

Cyril Cyril · Accepted Answer · 2019-05-16T15:49:24

Sounds like you just want a switch to determine where things will go, such that (untested):

lrs = wss.cells(wss.rows.count,5).end(xlup).row
for i = 2 to lrs 'assumes headers in row 1
    select case wss.cells(i,5).value
        Case is = 20
            col = 3
        Case is => 17,  is < 20
            col = 6
        'fil in others
    end select
    lrd = wsd.cells(wsd.rows.count,col).end(xlup).row
    wsd.cells(lrd+1,col).value = wss.cells(i,1).value
next i

figure out where your column A value is goign to end up, which requires the last row to be found in each destionation column (lrd), putting the value from your looped column A in source worksheet (wss) into the appropriate column of destination sheet (wsd).

Copy multiple rows from selected columns if condition met

2 Answers