Sub macro() Dim i As Integer Dim selection1 As String Dim selection2 As String i = 1 Application.ScreenUpdating = False Sheets("nom de la feuille 1").Select ' selection de la feuile 1 [ change le nom] Cells(i, 1).Select While ActiveCell.Value <> "" 'parcourt de la colone A If Mid(ActiveCell.Value, 1, 1) = "*" Then 'si la ligne commence par * selection1 = i & ":" & i Rows(selection1).Select 'copie selection.Copy Sheets("nom de la feuille 2").Select 'selection de la feuile 2 [ change le nom] selection2 = Range("A65536").End(xlUp).Row + 1 & ":" & Range("B65536").End(xlUp).Row + 1 'selection de la dernière case libdre Rows(selection2).Select ActiveSheet.Paste ' Sheets("nom de la feuille 1").Select End If i = i + 1 Cells(i, 1).Select Wend Application.ScreenUpdating = True End Sub