Microsoft 365 VBA - Copier coller une plage de données d'un onglet source vers plusieurs autres onglets correspondant à un critère

Créer une discussion
Répondre

Boostez vos compétences Excel avec notre communauté !

Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force. Apprenez, échangez, progressez – et tout ça gratuitement ! 👉 Inscrivez-vous maintenant !

S'inscrire
N

nikholas928

XLDnaute Nouveau
Bonjour à tous,

Voici mon souci (je vous joints mon fichier pour plus de simplicité), en somme, de l'onglet "GL", je souhaiterais créer un onglet par entités différentes (colonne A : FR03, FR05...) par ordre croissant en collant l'ensemble des données de ces entités (colonne A à O) dans l'onglets créé à cet effet (copier l'ensemble des données de la colonne A à O de FR03 dans un nouvel onglet FR03), et ainsi de suite pour les autres.
J'ai essayé plusieurs macro mais je me retrouve toujours bloqué.
Un d'entre vous aurait-il une macro simple d'utilisation pour effectuer cette tâche ?

Un grand merci à toutes celles et ceux qui me répondront 🙂
 

Pièces jointes

Trier par date Trier par votes
Bonsoir

Adapté d'un code de JB
(donc issu des archives du forum)
VB: 
Sub Test_OK()
  Application.DisplayAlerts = False
  Application.ScreenUpdating = False
  Sheets("GL").Select
  '--- Liste des sociétés
  [A1:O10000].AdvancedFilter Action:=xlFilterCopy, CopyToRange:=[Q1], Unique:=True
  Range("Q1:Q10000").Sort Key1:=Range("Q2"), Order1:=xlAscending, Header:=xlYes

  For Each c In Range("Q2", [Q65000].End(xlUp))   ' pour chaque service
     [Q2] = c.Value
     On Error Resume Next
     Sheets(c.Value).Delete
     On Error GoTo 0
     Sheets.Add After:=Sheets(Sheets.Count)   ' création
     ActiveSheet.Name = c.Value
     '-- extraction
     Sheets("GL").[A1:I10000].AdvancedFilter Action:=xlFilterCopy, _
            CriteriaRange:=Sheets("GL").[Q1:Q2], CopyToRange:=[A1]
     Sheets("GL").Select
   Next c
End Sub
NB: test OK sur mon PC.
 
Vote positif 0 Vote négatif
Bonjour @nikholas928 🙂,
Et surtout pour saluer le retour de l'agrafe @Staple1600 😜,

Une autre macro entièrement commentée. La méthode est différente de celle de @Staple1600.
Cliquer sur le bouton Hop! associé à la macro ventiler dans Module1:
VB: 
Sub ventiler()
Dim x, derlig&, t, i1&, i2&, i
   With Worksheets("GL")      'avec la feuille "GL"
      Application.ScreenUpdating = False: Application.DisplayAlerts = False   'on fige l'écran et desactive les alertes
      For Each x In ThisWorkbook.Worksheets     'pour chaque feuille de calcul de ce classeur
         If x.Name <> "GL" Then x.Delete        'si son nom est différent de GL alors on efface la feuille de calcul
      Next x
      Application.DisplayAlerts = True    'on réactive les messages d'alerte
      If .FilterMode Then .ShowAllData    'si un filtre est actif alors on affiche toutes les lignes
      derlig = .Cells(.Rows.Count, "a").End(xlUp).Row    'dernière ligne des données
      'on trie les huits première colonne selon le critère  colonne A (Société)
      .Range("a:o").Resize(derlig).Sort key1:=.Range("a1"), order1:=xlAscending, Header:=True
      t = .Range("a1:a" & derlig)   'on transfère les valeurs de la colonne A dans ule tableau en mémoire t
     
      'PRINCIPE : comme la colonne A est triée, on va partir de la ligne i1=2 et on va
      'incrémenter i2 (à partir de i1) tant que la société est la même que celle de la ligne i1.
      'Quand la société de la ligne(i2+1)sera différente de celle de la ligne i1, alors
      'on copiera le bloc de lignes i1 à i2 sur une nouvelle feuille
      'puis on recommencera la même chose à partir de la ligne i2+1 pour la nouvelle société.
     
      'Un cas particulier est quand i2 est la dernière ligne des données : dans ce cas, il faut copier
      'le bloc [i1,i2] mais sortir ensuite de la boucle puisqu'on sera arrivé à la fin des données.
     
      'i1 est la première ligne des données à copier ; i2 sera la dernière ligne à copier
      i1 = 2: i2 = i1      't(i1,1) est la société qu'on traite
      Do       'boucle sans fin
         If i2 = UBound(t) Then    'si i2 est la dernière ligne des données
            ThisWorkbook.Worksheets.Add after:=ThisWorkbook.Worksheets(ThisWorkbook.Worksheets.Count) 'créer une nouvelle feuille
            .Range("1:1").Copy ActiveSheet.Range("1:1")     'copier les en-têtes dela feuille GL vers la nouvelle feuille
            .Range(i1 & ":" & i2).Copy ActiveSheet.Range("2:2")   'copier les lignes de i1 à i2 vers la nouvelle feuille
            ActiveSheet.Name = t(i1, 1)      'nommer la nouvelle feuille avec le nom idoine
            ActiveSheet.Columns("a:o").EntireColumn.AutoFit    'ajuster la largeur des colonnes de la nouvelles feuille
            Exit Do     'comme on a atteint la fin des données on sort de la boucle
         ElseIf t(i2 + 1, 1) <> t(i2, 1) Then      'la société suivante sera différente de la société en cours
            ThisWorkbook.Worksheets.Add after:=ThisWorkbook.Worksheets(ThisWorkbook.Worksheets.Count) 'créer une nouvelle feuille
            .Range("1:1").Copy ActiveSheet.Range("1:1")     'copier les en-têtes dela feuille GL vers la nouvelle feuille
            .Range(i1 & ":" & i2).Copy ActiveSheet.Range("2:2")   'copier les lignes de i1 à i2 vers la nouvelle feuille
            ActiveSheet.Name = t(i1, 1)      'nommer la nouvelle feuille avec le nom idoine
            ActiveSheet.Columns("a:o").EntireColumn.AutoFit    'ajuster la largeur des colonnes de la nouvelles feuille
            'le nom de société suivant est une nouvelle société, on commencera la copie suivante à la ligne i2+1
            i1 = i2 + 1: i2 = i2 + 1
         Else
            'la société suivante (i2+1)est idendique à la société courante i2, on doit donc
            'inclure dans la copie la ligne i2 donc i2 passe à i2+1
            i2 = i2 + 1
         End If
      Loop
   End With
End Sub
 

Pièces jointes

Dernière édition:
Vote positif 0 Vote négatif
mapomme à dit:
Bonjour @nikholas928 🙂,
Et surtout pour saluer le retour de l'agrafe @Staple1600 😜,

Une autre macro entièrement commentée. La méthode est différente de celle de @Staple1600.
Cliquer sur le bouton Hop! associé à la macro ventiler dans Module1:
VB: 
Sub ventiler()
Dim x, derlig&, t, i1&, i2&, i
   With Worksheets("GL")      'avec la feuille "GL"
      Application.ScreenUpdating = False: Application.DisplayAlerts = False   'on fige l'écran et desactive les alertes
      For Each x In ThisWorkbook.Worksheets     'pour chaque feuille de calcul de ce classeur
         If x.Name <> "GL" Then x.Delete        'si son nom est différent de GL alors on efface la feuille de calcul
      Next x
      Application.DisplayAlerts = True    'on réactive les messages d'alerte
      If .FilterMode Then .ShowAllData    'si un filtre est actif alors on affiche toutes les lignes
      derlig = .Cells(.Rows.Count, "a").End(xlUp).Row    'dernière ligne des données
      'on trie les huits première colonne selon le critère  colonne A (Société)
      .Range("a:o").Resize(derlig).Sort key1:=.Range("a1"), order1:=xlAscending, Header:=True
      t = .Range("a1:a" & derlig)   'on transfère les valeurs de la colonne A dans ule tableau en mémoire t
   
      'PRINCIPE : comme la colonne A est triée, on va partir de la ligne i1=2 et on va
      'incrémenter i2 (à partir de i1) tant que la société est la même que celle de la ligne i1.
      'Quand la société de la ligne(i2+1)sera différente de celle de la ligne i1, alors
      'on copiera le bloc de lignes i1 à i2 sur une nouvelle feuille
      'puis on recommencera la même chose à partir de la ligne i2+1 pour la nouvelle société.
   
      'Un cas particulier est quand i2 est la dernière ligne des données : dans ce cas, il faut copier
      'le bloc [i1,i2] mais sortir ensuite de la boucle puisqu'on sera arrivé à la fin des données.
   
      'i1 est la première ligne des données à copier ; i2 sera la dernière ligne à copier
      i1 = 2: i2 = i1      't(i1,1) est la société qu'on traite
      Do       'boucle sans fin
         If i2 = UBound(t) Then    'si i2 est la dernière ligne des données
            ThisWorkbook.Worksheets.Add after:=ThisWorkbook.Worksheets(ThisWorkbook.Worksheets.Count) 'créer une nouvelle feuille
            .Range("1:1").Copy ActiveSheet.Range("1:1")     'copier les en-têtes dela feuille GL vers la nouvelle feuille
            .Range(i1 & ":" & i2).Copy ActiveSheet.Range("2:2")   'copier les lignes de i1 à i2 vers la nouvelle feuille
            ActiveSheet.Name = t(i1, 1)      'nommer la nouvelle feuille avec le nom idoine
            ActiveSheet.Columns("a:o").EntireColumn.AutoFit    'ajuster la largeur des colonnes de la nouvelles feuille
            Exit Do     'comme on a atteint la fin des données on sort de la boucle
         ElseIf t(i2 + 1, 1) <> t(i2, 1) Then      'la société suivante sera différente de la société en cours
            ThisWorkbook.Worksheets.Add after:=ThisWorkbook.Worksheets(ThisWorkbook.Worksheets.Count) 'créer une nouvelle feuille
            .Range("1:1").Copy ActiveSheet.Range("1:1")     'copier les en-têtes dela feuille GL vers la nouvelle feuille
            .Range(i1 & ":" & i2).Copy ActiveSheet.Range("2:2")   'copier les lignes de i1 à i2 vers la nouvelle feuille
            ActiveSheet.Name = t(i1, 1)      'nommer la nouvelle feuille avec le nom idoine
            ActiveSheet.Columns("a:o").EntireColumn.AutoFit    'ajuster la largeur des colonnes de la nouvelles feuille
            'le nom de société suivant est une nouvelle société, on commencera la copie suivante à la ligne i2+1
            i1 = i2 + 1: i2 = i2 + 1
         Else
            'la société suivante (i2+1)est idendique à la société courante i2, on doit donc
            'inclure dans la copie la ligne i2 donc i2 passe à i2+1
            i2 = i2 + 1
         End If
      Loop
   End With
End Sub
Cliquez pour agrandir...
@mapomme Ton code est super ! Je te remercie énormément.
Une dernière petite chose, saurais-tu comment, pour chacun des onglets créés, intégrer un classement de A à Z de la colonne D puis en triant la colonne I par date la plus ancienne à la plus récente.
Et en dernier lieu d'ajouter des sous-totaux en sommant la colonne K à chaque changement de numéro de la colonne D ?
J'espère ne pas trop en demander.

En tout cas, je vous remercie beaucoup pour toute l'aide apportée déjà 🙂

Bonne journée,
 
Vote positif 0 Vote négatif
Staple1600 à dit:
Bonsoir

Adapté d'un code de JB
(donc issu des archives du forum)
VB: 
Sub Test_OK()
  Application.DisplayAlerts = False
  Application.ScreenUpdating = False
  Sheets("GL").Select
  '--- Liste des sociétés
  [A1:O10000].AdvancedFilter Action:=xlFilterCopy, CopyToRange:=[Q1], Unique:=True
  Range("Q1:Q10000").Sort Key1:=Range("Q2"), Order1:=xlAscending, Header:=xlYes

  For Each c In Range("Q2", [Q65000].End(xlUp))   ' pour chaque service
     [Q2] = c.Value
     On Error Resume Next
     Sheets(c.Value).Delete
     On Error GoTo 0
     Sheets.Add After:=Sheets(Sheets.Count)   ' création
     ActiveSheet.Name = c.Value
     '-- extraction
     Sheets("GL").[A1:I10000].AdvancedFilter Action:=xlFilterCopy, _
            CriteriaRange:=Sheets("GL").[Q1:Q2], CopyToRange:=[A1]
     Sheets("GL").Select
   Next c
End Sub
NB: test OK sur mon PC.
Cliquez pour agrandir...
désoler de poser une question ici @Staple1600
j'espéré que tu pourras m'aider.

Dans le code on prend la colonne A colonne I .
si je vous voudrais rajouter la colonne par exemple M a O sans avoir ( I à M) ?

qui recopie un model a chaque fois c'est possible ?

merci a la personne qui m'aider 🙂

tu pourrai m'aider merci de m'aider .

désoler pour les faute je suis dyslexique
 
Dernière édition:
Vote positif 0 Vote négatif
Re @nikholas928 🙂

pour chacun des onglets créés, intégrer un classement de A à Z de la colonne D puis en triant la colonne I par date la plus ancienne à la plus récente.
Et en dernier lieu d'ajouter des sous-totaux en sommant la colonne K à chaque changement de numéro de la colonne D
Cliquez pour agrandir...

Voici une version v2 qui devrait faire ce que tu as demandé.
J'ai vérifié succinctement. A toi de pousser les vérifications.
Le nouveau code est aussi commenté.
 

Pièces jointes

Dernière édition:
Vote positif 0 Vote négatif
mapomme à dit:
Re @nikholas928 🙂



Voici une version v2 qui devrait faire ce que tu as demandé.
J'ai vérifié succinctement. A toi de pousser les vérifications.
Le nouveau code est aussi commenté.
Cliquez pour agrandir...
@mapomme Merci beaucoup à toi ! C'est très bien, juste que je ne dois pas afficher le total de la colonne D. Seulement celui de la colonne K.
Pourrais-tu me dire comment je peux supprimer celui de la colonne D ?
Je te remercie 🙂
 
Vote positif 0 Vote négatif
nikholas928 à dit:
je ne dois pas afficher le total de la colonne D. Seulement celui de la colonne K.
Cliquez pour agrandir...
Re,

En colonne D, aucun total n'est affiché. C'est juste le rappel "du compte général" lié au sous-total de la ligne (pour plus de lisibilité).
Voir la version jointe qui n'inscrit plus rien en colonne D sur les lignes des sous-totaux.
 

Pièces jointes

Vote positif 0 Vote négatif
Bonjour le fil

@mapomme n'étant pas un pied nickelé, je m'autorise subséquemment à ne point répondre à la question du message#8 😉

NB: Si ce message vous parait abscons, c'est normal. Mais moi, je me comprends 😉

PS: mes salutations à l'aficionado du fruit à pépins qui pris chaque matin éloigne le médecin. 😉
 
Vote positif 0 Vote négatif
Rejoins nos membres "Supporter XLD" et booste ton expérience Excel !
- Navigue sans publicité
- Accède à Cléa, notre assistante IA experte Excel... et pas que...
- Profite de fonctionnalités exclusives
Ton soutien permet à Excel Downloads de rester 100% gratuit et de continuer à rassembler les passionnés d'Excel.
Je deviens Supporter XLD

Discussions similaires

fenec
  • Question Question
XL 2021 Copier une plage de données d'après un critère en VBA
2
Réponses
22
Affichages
358
fenec
fenec
P
  • Résolu(e)
XL 2021 Besoin d'aide pour copier/coller données de plusieurs classeurs
2
Réponses
20
Affichages
798
Pac41240
P
Lisette
  • Question Question
Microsoft 365 VBA : copier / coller d'un onglet à l'autre en fonction d'une valeur
Réponses
8
Affichages
617
Lisette
Lisette
O
  • Question Question
XL 2013 Recopier automatique des valeurs d'un onglet vers un autre onglet selon critère
Réponses
2
Affichages
542
olivieroma
O
S
  • Question Question
XL 2016 VBA - copier coller des données d'un onglet vers un nouvel onglet
Réponses
1
Affichages
786
vgendron
vgendron
D
  • Résolu(e)
Microsoft 365 Copier / coller données spécifiques documents txt vers Excel
Réponses
3
Affichages
600
Staple1600
Staple1600
G
  • Question Question
XL 2021 rassembler des données de plusieurs feuilles d'un classeur sur une nouvelle feuille du meme classeur selon un critère
Réponses
1
Affichages
466
Staple1600
Staple1600
D
  • Question Question
XL 2016 VBA - Copier/coller valeur d'une cellule, sur une plage de cellule données.
2 3
Réponses
34
Affichages
2 K
DaONE
D
P
  • Question Question
XL 2021 Code VBA pour copier coller des données de cellules d'une feuille a une autre
Réponses
4
Affichages
634
phoceenjo
P
M
  • Question Question
Microsoft 365 VBA copier des données d'un classeur à un autre
Réponses
4
Affichages
1 K
sylvanu
sylvanu
S
  • Question Question
Microsoft 365 VBA pour copier une une des données d'une ligne à une autre
Réponses
3
Affichages
659
salma_hayek
S
M
  • Question Question
Microsoft 365 Macro copier/coller plusieurs onglets en 1
Réponses
7
Affichages
669
vgendron
vgendron
T
  • Question Question
Microsoft 365 Copier et incrémenter une plage de données dans un autre onglet
Réponses
7
Affichages
646
tonino06200
T
A
  • Résolu(e)
Microsoft 365 Alimenter automatiquement un tableau à partir des données d'un autre tableau en fonction d'un critère
Réponses
9
Affichages
1 K
Alexandrax971
A
T
  • Question Question
Microsoft 365 Copier/coller d'un onglet à l'autre correspondant au mois
2
Réponses
19
Affichages
1 K
TAL
T
S
  • Résolu(e)
Microsoft 365 VBA pour copier/coller une plage de cellule dans un autre onglet en fonction de la date
Réponses
8
Affichages
1 K
Sylvain. B
S
A
  • Question Question
XL 2019 Copier une plage dans un fichier fermé en VBA
2
Réponses
21
Affichages
2 K
Amilo
A
G
  • Question Question
Microsoft 365 Copier/Coller plage de cellule vers nouvel onglet
Réponses
3
Affichages
1 K
Jacky67
Jacky67
9
  • Question Question
Microsoft 365 Copier Coller les données (cellules) de plusieurs feuilles d'un classeur vers plusieurs autres feuilles d'un classeur
Réponses
5
Affichages
1 K
92lever
9
M
  • Question Question
XL 2019 EXCEL-VBA : Besoin de copier coller sous condition
Réponses
5
Affichages
871
fanch55
fanch55
Retour