Sub Dispatcher() Dim VnomOnglet As String
Dim Col%, NBCol%
Dim Rep As String
NBCol = Feuil1.UsedRange.Columns.Count
Rep = MsgBox("Voulez-vous effacer les onglets", vbYesNo, "Effacement des onglets")
If Rep = vbYes Then Call SupOnglet
On Error Resume Next
Col = InputBox("Quelle est la colonne à dispatcher ?", "Choix", 1)
If Col > NBCol Then
MsgBox "Le nombre de colonnes est de " & NBCol & Chr(10) & "Vous ne pouvez pas demander " & Col & "...", vbCritical, "Oups..."
Exit Sub
End If
Application.ScreenUpdating = 0
Cells(1, Col).Select
Range(Selection, Selection.End(xlDown)).Select
For Each vcell In Selection
VnomOnglet = vcell.Value
vcell.Offset(0, 1 - Col).Range("A1:D1").Select
Selection.Copy
'si l'onglet existe
If FeuilExiste(VnomOnglet) Then
'si l'onglet 'existe pas
Sheets(VnomOnglet).Select
ActiveCell.Offset(1, 0).Range("A1").Select
Else
Sheets.Add after:=Feuil1
ActiveSheet.Name = VnomOnglet
End If
ActiveSheet.Paste
Sheets("Données").Select
Next
Application.CutCopyMode = False
Range("A1").Select
End Sub
Sub SupOnglet()
Application.DisplayAlerts = 0
For Each Sheet In Sheets
If Sheet.Name <> "Données" Then Sheets(Sheet.Name).Delete
Next
Application.DisplayAlerts = 1
ActiveWorkbook.Save
End Sub
Function FeuilExiste(F As String) As Boolean
On Error Resume Next
FeuilExiste = Not Sheets(F) Is Nothing
End Function