XL 2010 Lister des noms commençant par un certain caractére

Option Explicit
Sub Lister()
    Dim c As Range
    With Application: .ScreenUpdating = False: .Calculation = xlManual: .EnableEvents = False: End With
    Sheets("Feuil2").Range("d3:f" & Rows.Count).Clear
    For Each c In Columns(2).SpecialCells(xlContents)
        If Left(c, 1) = "R" Then c.Copy Destination:=Sheets("Feuil2").Range("d" & Rows.Count).End(xlUp)(2)
    Next
    For Each c In Columns(4).SpecialCells(xlContents)
        If Left(c, 1) = "R" Then c.Copy Destination:=Sheets("Feuil2").Range("e" & Rows.Count).End(xlUp)(2)
    Next
    For Each c In Columns(6).SpecialCells(xlContents)
        If Left(c, 1) = "R" Then c.Copy Destination:=Sheets("Feuil2").Range("f" & Rows.Count).End(xlUp)(2)
    Next
    With Sheets("Feuil2"): .Activate: .Columns("d:f").EntireColumn.AutoFit: .Range("d1").CurrentRegion.Borders.Value = 1: End With
    With Application: .EnableEvents = True: .Calculation = xlAutomatic: .ScreenUpdating = True: End With
End Sub