Bonjour,
comme ceci alors
P.
edit: test d'existence de l'onglet du pays
Hello à mes camarades de classe
Option Explicit
Sub SPLIT_EN_ONGLET_RAPIDE()
Dim Bd, A, i, k, D, T, f, mCode
Set f = Sheets("données") ' codename de la feuil1 (au cas d'un changement de nom) ici feuil1 est celle de départ
Application.DisplayAlerts = False
Application.ScreenUpdating = False
Bd = f.Range("A2:D" & f.[A65000].End(xlUp).Row) ' on met dans une base de données
Set D = CreateObject("scripting.dictionary") ' on scanne la base de données et la mets dans un dictionnaire (+ rapide)
For i = 1 To UBound(Bd): D(Bd(i, 4)) = D(Bd(i, 4)) & i & ",": Next ' dictionnaire
' on splitte ici sur la colonne D
For Each k In D.Keys
On Error Resume Next
If Not WorksheetExists(UCase(k)) Then
Sheets.Add after:=Sheets(Sheets.Count) ' ajout d'une feuille
ActiveSheet.Name = UCase(k) ' on nomme la feuille comme chacune des différentes occurences de la colonne D
End If
On Error GoTo 0
' on reprends toutes les données d'une même occurence pour les coller en A2 d'une nouvelle feuille
A = Application.Index(Bd, Application.Transpose(Split(D.Item(k), ",")), _
Application.Transpose(Evaluate("Row(1:" & UBound(Bd, 2) & ")"))) ' extraction array()
Sheets(k).[A2].Resize(UBound(A) - 1, UBound(A, 2)) = A
Feuil1.[A1:D1].Copy Sheets(k).[A1] 'copie des titres vers la nouvelle feuille
Next k
End Sub
Public Function WorksheetExists(ByVal WorksheetName As String) As Boolean
Dim Sht As Worksheet
WorksheetExists = False
For Each Sht In ActiveWorkbook.Worksheets
If Sht.Name = WorksheetName Then WorksheetExists = True
Next Sht
End Function