Başlangıç Değerine Göre Satırları Başka Sayfaya Kopyalamak

Private Sub CommandButton1_Click()
    bor = 18
    kb = 21
    e12 = 24
    kp = 27
    pls = 30
    t12 = 33
    Application.ScreenUpdating = False
    For i = 2 To Sayfa1.Range("a65536").End(3).Row
        If Sayfa1.Cells(i, 1).Interior.Color = 16777215 Then
            If Sayfa1.Cells(i, 1).Value Like "BOR-*" Then
                Sayfa2.Rows(bor & ":" & bor).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
                For ii = 1 To 4
                    Sayfa2.Cells(bor - 1, ii) = Sayfa1.Cells(i, ii)
                Next ii
                bor = bor + 1
                kb = kb + 1
                e12 = e12 + 1
                kp = kp + 1
                pls = pls + 1
                t12 = t12 + 1
            ElseIf Sayfa1.Cells(i, 1).Value Like "KBL-*" Then
                Sayfa2.Rows(kb & ":" & kb).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
                For ii = 1 To 4
                    Sayfa2.Cells(kb - 1, ii) = Sayfa1.Cells(i, ii)
                Next ii
                kb = kb + 1
                e12 = e12 + 1
                kp = kp + 1
                pls = pls + 1
                t12 = t12 + 1
            ElseIf Sayfa1.Cells(i, 1).Value Like "E-*" Then
                Sayfa2.Rows(e12 & ":" & e12).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
                For ii = 1 To 4
                    Sayfa2.Cells(e12 - 1, ii) = Sayfa1.Cells(i, ii)
                Next ii
                e12 = e12 + 1
                kp = kp + 1
                pls = pls + 1
                t12 = t12 + 1
            ElseIf Sayfa1.Cells(i, 1).Value Like "K-*" Then
                Sayfa2.Rows(kp & ":" & kp).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
                For ii = 1 To 4
                    Sayfa2.Cells(kp - 1, ii) = Sayfa1.Cells(i, ii)
                Next ii
                kp = kp + 1
                pls = pls + 1
                t12 = t12 + 1
            ElseIf Sayfa1.Cells(i, 1).Value Like "P-*" Then
                Sayfa2.Rows(kp & ":" & kp).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
                For ii = 1 To 4
                    Sayfa2.Cells(kp - 1, ii) = Sayfa1.Cells(i, ii)
                Next ii
                kp = kp + 1
                pls = pls + 1
                t12 = t12 + 1
            ElseIf Sayfa1.Cells(i, 1).Value Like "PLS-*" Then
                Sayfa2.Rows(pls & ":" & pls).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
                For ii = 1 To 4
                    Sayfa2.Cells(pls - 1, ii) = Sayfa1.Cells(i, ii)
                Next ii
                pls = pls + 1
                t12 = t12 + 1
            ElseIf Sayfa1.Cells(i, 1).Value Like "T-*" Then
                Sayfa2.Rows(t12 & ":" & t12).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
                For ii = 1 To 4
                    Sayfa2.Cells(t12 - 1, ii) = Sayfa1.Cells(i, ii)
                Next ii
                t12 = t12 + 1
            End If
        End If
    Next i
   
    Sayfa2.Select
    Application.ScreenUpdating = True
    MsgBox "Aktarım tamamlandı...", vbInformation, "By Emre ÇAKAR & exceldestek.com"
End Sub