0

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)

  1. 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)

  2. 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)

  3. 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)

  4. 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

Improve this question

2 Answers 2

Reset to default
2

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).

Improve this answer
Sign up to request clarification or add additional context in comments.

1 Comment

Hello, Thank you for your help. I just updated my code and it worked well.
0

Another Problem

If I don't use function Call, I will get this kind of result Result of function without call

[Main Table][2]

Improve this answer

2 Comments

This is not the right format to ask another question, you need to ask the new question the same way you did the original. Also, if @Cyril answered your question, you should mark it as the answer.
Thank you for your info.

Start asking to get answers

Find the answer to your question by asking.

Ask question

Explore related questions

See similar questions with these tags.