Sub ExtractionDonnees()
Dim DLig As Long, Lig As Long
Dim RngF1 As Range, RngF2 As Range, FirstLig As Long
' Ajouter une feuille dans le classeur
Sheets.Add After:=Sheets(1)
' Initialiser les variables
Lig = 1: FirstLig = 1
' Avec la feuille active
With Sheets(1)
.Activate
' Récupérer la dernière ligne remplie
DLig = .Range("A" & Rows.Count).End(xlUp).Row
' Rechercher la valeur souhaitée
Set RngF1 = .Range("A" & Lig & ":A" & DLig).Find(What:="Information de Stats de joueur", _
LookIn:=xlValues, LookAt:=xlPart, SearchOrder:=xlByRows, _
SearchDirection:=xlNext, MatchCase:=False) ' After:=ActiveCell
Do While Not RngF1 Is Nothing
Lig = RngF1.Row
' Trouver la ligne contenant les étoiles (faire précéder les étoiles d'un tildé)
Set RngF2 = .Range("A" & Lig & ":A" & DLig).Find(What:="~*~*~*~*", _
LookIn:=xlValues, LookAt:=xlPart, SearchOrder:=xlByRows, _
SearchDirection:=xlNext, MatchCase:=False)
' Selection des lignes pour avoir un visuel (pas obligatoire)
.Rows(RngF1.Row & ":" & RngF2.Row - 1).Select
' Couper la sélection
Selection.Copy Destination:=Sheets(2).Range("A" & Rows.Count).End(xlUp).Offset(1, 0)
Selection.ClearContents
' Mémoriser le numéro de la dernière ligne trouvée
Lig = RngF2.Row
' Rechercher de nouveau la valeur souhaitée
Set RngF1 = .Range("A" & Lig & ":A" & DLig).Find(What:="Information de Stats de joueur", _
LookIn:=xlValues, LookAt:=xlPart, SearchOrder:=xlByRows, _
SearchDirection:=xlNext, MatchCase:=False)
Loop
End With
Sheets(2).Activate
MsgBox "C'est fini"
End Sub