pbs macros excel VBA

Sub LignesGrisees()
    Dim lngLigneDebut   As Long
    Dim lngLigneFin     As Long
    Dim wbkClasseur     As Workbook
    Dim strRange        As String
 
    ' création d'un nouveau classeur
    Set wbkClasseur = Workbooks.Add
 
    ' on revient sur le fichier source
    ThisWorkbook.Activate
 
    ' on isole les lignes non-blanches
    lngLigneDebut = 1
    lngLigneFin = 1
    Do Until Cells(lngLigneDebut, 1).Value = ""
        If Cells(lngLigneDebut, 1).Interior.ColorIndex <> xlNone Then
            lngLigneFin = lngLigneDebut
            Do While Cells(lngLigneFin, 1).Interior.ColorIndex <> xlNone
                lngLigneFin = lngLigneFin + 1
            Loop
            strRange = strRange & lngLigneDebut & ":" & lngLigneFin - 1 & ","
            lngLigneDebut = lngLigneFin
        Else
            lngLigneDebut = lngLigneDebut + 1
        End If
    Loop
    ' enlever la dernière virgule
    strRange = Left(strRange, Len(strRange) - 1)
 
    ' on copie les lignes non-blanches
    Range(strRange).Copy
 
    ' et on les colle dans le nouveau classeur
    wbkClasseur.Activate
    ActiveSheet.Paste
    ' puis on se positionne juste en dessous
    ' pour pouvoir continuer les copier/coller
    Range("A65536").End(xlUp).Offset(1, 0).Select
 
    Set wbkClasseur = Nothing
End Sub