Copier les lignes dans une autre feuille selon condition

Bonjour à tous,

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

Bonjour Paulo, bonjour le forum,

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 <> 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...

Bonjour ThauThème,

Merci beaucoup pour le code, ça marche pas mal !!

J'ai juste un problème, quand je décide de tout attribuer à une seule personne, les feuilles concernant les 2 autres sont toujours remplies (voir fichier joint...). Comment dois-je modifier ton code ?

Dernier petit détail, j'ai voulu affecter la macro à un bouton de contrôle afin de l'activer dès que j'ai fini les modifications de mon tableau de données, et une fois que j'ai cliqué sur le bouton, celui-ci se réduit à une ligne (hauteur du bouton : 0 cm).

Avez-vous une solution à ce problème ?

Cordialement,

Paul

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 :

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

Parfait,

Merci pour tout en tout cas ça va me faire gagner un temps fou !!

Au plaisir,

Paul

Rechercher des sujets similaires à "copier lignes feuille condition"