Générer des repos par critères

Sub MettreRR()
Dim RR1 As String, RR2 As String
Dim RR3 As String, RR4 As String
Dim RR5 As String, RR6 As String
Dim i As Integer
i = 3
RR1 = Range("a3").Text
RR2 = Range("a4").Text
RR3 = Range("a5").Text
RR4 = Range("a6").Text
RR5 = Range("a7").Text
RR6 = Range("a8").Text

Do
Select Case Range("a" & i).Text
    Case RR1
        Range("e" & i) = "RR"
        RR1 = Cells(i + 6, 1).Text
    Case RR2
        Range("f" & i) = "RR"
        RR2 = Cells(i + 6, 1).Text
    Case RR3
        Range("g" & i) = "RR"
        RR3 = Cells(i + 6, 1).Text
    Case RR4
        Range("h" & i) = "RR"
        RR4 = Cells(i + 6, 1).Text
    Case RR5
        Range("i" & i) = "RR"
        RR5 = Cells(i + 6, 1).Text
    Case RR6
        Range("j" & i) = "RR"
        RR6 = Cells(i + 6, 1).Text
End Select
i = i + 1
Loop Until Range("a" & i) = ""
End Sub