Sub Bouton99_Clic()
Application.ScreenUpdating = False
Sheets("fonction").Visible = True
Sheets("Modèle").Visible = True
Application.DisplayAlerts = False
For j = 4 To Sheets.Count
Sheets(4).Delete
Next j
Application.DisplayAlerts = True
Sheets("fonction").Activate
Range("A2").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Clear
Sheets("fonction").Range("A1").Value = Sheets("Feuil1").Range("B5").Value
Sheets("Feuil1").Activate
Range("B5").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Sheets("fonction").Range("A1"), Unique:=True
Selection.Copy
Sheets("fonction").Activate
Nbligne = Range("A1").CurrentRegion.Rows.Count
For f = 2 To Nbligne
newfeuille = Sheets("fonction").Cells(f, 1).Value
Sheets("Modèle").Copy after:=Sheets(3)
ActiveSheet.Name = newfeuille
Next f
Sheets(1).Activate
Range("b6").Select
Do While ActiveCell.Value <> ""
Feuille = ActiveCell.Value
'MsgBox Feuille
For i = 4 To Sheets.Count
If Sheets(i).Name = Feuille Then
cherche = True
ligne = ActiveCell.Row
Rows(ligne).Copy
Sheets(Feuille).Activate
Range("b10000").End(xlUp).Offset(3, -1).Select
Selection.PasteSpecial
Else
cherche = False
End If
Next i
'If cherche = False Then
'Sheets(Feuille).Add
' End If
'Destination =
' Range("a60000").End(xlUp).Offset(1, 0).PasteSpecial
'Rows(Destination).Paste
'End If
Sheets(1).Activate
ActiveCell.Offset(1, 0).Select
Loop
Sheets("fonction").Visible = False
Sheets("Modèle").Visible = False
Application.ScreenUpdating = True
ActiveSheet.Columns("AX:BL").Hidden = True
End Sub