Copier les lignes dans une autre feuille selon condition

Question

Je suis débutant sur VBA et j'aimerai trier un tableau de données à 10 colonnes. Je voudrais que les lignes soient copiées dans 3 autres feuilles différentes (intitulées Eric, Guillaume, Julien) selon le prénom sur ma colonne 10 ("J", liste déroulante de prénoms). Ainsi, je pourrais trier les informations selon le prénom et avoir une feuille par personne. Vous verrez dans le fichier ci-joint que j'avais essayé un code VBA en associant une couleur pour chaque prénom et trier grâce aux couleurs, mais je me suis rendu-compte que les MFC n'étaient pas compatibles avec le code. Du coup, j'aimerai un code qui utilise le mot de la colonne 10 (le prénom) pour trier au lieu de la couleur. Je vous remercie d'avance pour votre aide Paul...

ThauThème · Answer

Peut-être comme ça : Sub Macro1() Dim OS As Worksheet 'déclare la variable OS (Onglet Source) Dim PL As Range 'déclare la variable PL (PLage) Dim TV As Variant 'déclare la variable TV (Tableau des Valeurs) Dim D As Object 'déclare la variable D (Dictionnaire) Dim I As Integer 'déclare la variable I (Incrément) Dim TMP As Variant 'déclare la variable TMP (tableau TeMPoraire) Application.ScreenUpdating = False 'masque les rafraîchissements d'écran Set OS = Worksheets("A2D-RECAP") 'définit l'onglet source OS Set PL = OS.Range("A2").CurrentRegion 'définit la plage PL TV = PL 'définit le tableau des valeurs TV Set D = CreateObject("Scripting.Dictionary") 'définit la dictionnaire D For I = 2 To UBound(TV, 1) 'boucle sur toutes les lignes I du tableau des valeurs TV (en partant de la seconde) D(TV(I, 10)) = "" 'alimente le dictionnaire D avec les données en colonne 10 (le télépilote) Next I 'prochaine ligne de la boucle TMP = D.Keys 'récdupère dans le tableau temporaire TMP la liste des élémentds du dictionnaire D sans doublon For I = 0 To UBound(TMP) 'boucle sur tous les éléments du tableau temporaire TMP PL.AutoFilter 'annule le filtre automatique de la plage PL On Error Resume Next 'gestion des erreurs (en cas d'erreur passe à la ligne suivante) 'définit l'onglet de destination OD portant le nom l'élément I de TMP (génère une erreur si cet onglet n'existe pas) Set OD = Worksheets(TMP(I)) If Err &lt;&gt; 0 Then 'condition : si une erreur a été générée Err.Clear 'supprime l'erreur Worksheets.Add After:=Sheets(Sheets.Count) 'ajoute un onglet vierge en dernière position Set OD = ActiveSheet 'définit l'onglet OD OD.Name = TMP(I) 'renomme l'onglet OD End If 'fin de la condition On Error GoTo 0 'annule la gestion des erreurs OD.Cells.Clear 'efface la totalité de l'onglet OD PL.AutoFilter Field:=10, Criteria1:=TMP(I) 'filtre la plage PL sur la colonne 10 avec TMP(I) comme critère PL.SpecialCells(xlCellTypeVisible).Copy OD.Range("A1") 'copie les cellules visibles de la plage PL et les colle dans A1 de l'ongelt OD 'OD.Columns(10).Delete 'supprime la dernière colonne (mais supprime aussi la mise en forme conditionelle) Next I 'prochain élément de la boucle PL.AutoFilter 'annule le filtre automatique de la plage PL OS.Activate 'active l'onglet source OS Application.ScreenUpdating = True 'affiche les rafraîchissements d'écran End Sub Le code prévoit déjà l'ajout de nouveaux télépilotes.....

ThauThème · Answer

Re,

En pièce jointe ton fichier modifié. Les onglets des données sont d'abord effacés puis la copie est faite. Tu n'aura plus le problème. J'ai mis le bouton en haut comme ça il ne sera pas masqué par les filtres...

Le code :

Sub Macro1()
Dim OS As Worksheet 'déclare la variable OS (Onglet Source)
Dim PL As Range 'déclare la variable PL (PLage)
Dim TV As Variant 'déclare la variable TV (Tableau des Valeurs)
Dim D As Object 'déclare la variable D (Dictionnaire)
Dim I As Integer 'déclare la variable I (Incrément)
Dim TMP As Variant 'déclare la variable TMP (tableau TeMPoraire)

Application.ScreenUpdating = False 'masque les rafraîchissements d'écran
Application.DisplayAlerts = False 'masque les message d'Excel
Set OS = Worksheets("A2D-RECAP") 'définit l'onglet source OS
For I = 1 To Sheets.Count 'boucle sur tous les onglets du classeur
    Select Case Worksheets(I).Name 'agit en fontion du nom de l'onglet de la boucle
        Case "A2D-RECAP", "LISTE" 'cas où rien ne se passe (ajoute des noms à cette liste si tu as d'autres onglets à conserver)
        Case Else 'tous les autre cas
            Worksheets(I).Delete 'suppeime l'ongfet
    End Select 'fin de l'action en fonction du nom de l'onglet de la boucle
Next I 'prochain onglet de la boucle
Application.DisplayAlerts = True 'affiche les message d'Excel
Set PL = OS.Range("A2").CurrentRegion 'définit la plage PL
TV = PL 'définit le tableau des valeurs TV
Set D = CreateObject("Scripting.Dictionary") 'définit la dictionnaire D
For I = 2 To UBound(TV, 1) 'boucle sur toutes les lignes I du tableau des valeurs TV (en partant de la seconde)
    D(TV(I, 10)) = "" 'alimente le dictionnaire D avec les données en colonne 10 (le télépilote)
Next I 'prochaine ligne de la boucle
TMP = D.Keys 'récupère dans le tableau temporaire TMP la liste des éléments du dictionnaire D sans doublon
For I = 0 To UBound(TMP) 'boucle sur tous les éléments du tableau temporaire TMP
    PL.AutoFilter 'annule le filtre automatique de la plage PL
    Worksheets.Add After:=Sheets(Sheets.Count) 'ajoute un onglet vierge en dernière position
    Set OD = ActiveSheet 'définit l'onglet OD
    OD.Name = TMP(I) 'renomme l'onglet OD
    PL.AutoFilter Field:=10, Criteria1:=TMP(I) 'filtre la plage PL sur la colonne 10 avec TMP(I) comme critère
    PL.SpecialCells(xlCellTypeVisible).Copy OD.Range("A1") 'copie les cellules visibles de la plage PL et les colle dans A1 de l'ongelt OD
    'OD.Columns(10).Delete 'supprime la dernière colonne (mais supprime aussi la mise en forme conditionelle)
Next I 'prochain élément de la boucle
PL.AutoFilter 'annule le filtre automatique de la plage PL
OS.Activate 'active l'onglet source OS
Application.ScreenUpdating = True 'affiche les rafraîchissements d'écran
End Sub

Le fichier :

13paulo-ep-v01.xlsm (38.33 Ko)