寻找更好的代码复制粘贴从一张纸到另一张纸

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