Sub Macro1()
Columns("A:B").Select
ActiveWorkbook.Worksheets("Feuil1").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("Feuil1").Sort.SortFields.Add Key:=Range("A1:A21") _
, SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("Feuil1").Sort
.SetRange Range("A1:B21")
.Header = xlGuess
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
For n = 1 To Range("A" & Rows.Count).End(xlUp).Row
If Left(Range("A" & n), 1) = "3" And Left(Range("A" & n + 1), 1) <> "3" Then
debut = n + 1
aeffacer = n + 1
End If
If Left(Range("A" & n), 1) = "6" And Left(Range("A" & n + 1), 1) <> "6" Then
fin = n
Range(Cells(debut, 1), Cells(fin, 2)).Copy Destination:=Range("C1")
debut = n + 1
Exit For
End If
Next
For n = 1 To Range("A" & Rows.Count).End(xlUp).Row
If Left(Range("A" & n), 1) = "8" And Left(Range("A" & n + 1), 1) <> "8" Then
fin = n
Range(Cells(debut, 1), Cells(fin, 2)).Copy Destination:=Range("E1")
debut = n + 1
Exit For
End If
Next
Range("A" & aeffacer & ":B" & Rows.Count).ClearContents
End Sub