Ищите лучшую копию кода для вставки с одного листа на другой

Question

Я написал этот код, и он работал хорошо, как я хочу.Чтобы найти некоторые значения и скопировать, вставьте результат на другой лист (онлайн для выбранного столбца)

Я хочу узнать мнение этого сообщества относительно моего кода

Я только что узнал VBA для 1неделю.Надеюсь, что вы можете поделиться некоторыми полезными советами, спасибо:)

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