Microsoft 365 Macro Excel pour copier coller des lignes dans des onglets

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 !

Axelle B

XLDnaute Nouveau
Bonjour,
J'ai un tableau (+/- 1.000 lignes) de suivi de contrats par gestionnaire, et j'ai besoin que pour chaque gestionnaire (+/- 50), ses lignes soient copiées-collées dans un onglet distinct.
Le nom de la gestionnaire est en colonne C.
La macro peut-elle aller jusqu'à créer autant d'onglets que de gestionnaires ?
Est-ce utile pour simplifier la macro de saisir la liste des gestionnaires ?
Je ne sais pas créer de macro : ces questions ne font peut-être pas sens....
Si quelqu'un a le temps de me répondre, ça me serait une aide précieuse
Merci d'avance,
Axelle
 

Pièces jointes

Bonjour Axelle et bienvenu sur XLD,
Un essai en PJ. Par contre on doit dupliquer manuellement les feuilles, avec une par gestionnaire. Mais c'est fait une fois pour toute.
Une feuille doit porter le nom du gestionnaire, tel qu'apparaissant dans la liste.
En A2, on utilise le nom de la feuille comme critère de recherche, avec :
VB:
=DROITE(CELLULE("nomfichier";A1);NBCAR(CELLULE("nomfichier";A1))-TROUVE("]";CELLULE("nomfichier";A1)))
Puis pour la recherche proprement dite on utilise :
Code:
=SI(LIGNES($1:1)<=NB.SI(Feuil1!$C$4:$C$10000;AB!$A$2);INDEX(Feuil1!D$4:D$10;PETITE.VALEUR(SI(Feuil1!$C$4:$C$10000=Feuil1!Criteres;LIGNE(INDIRECT("1:"&LIGNES(Feuil1!$C$4:$C$10000))));LIGNES($1:1)));"")
Formule matricielle, donc à valider par Maj+Ctrl+Entrée.
( J'ai limité à 500 le nombre de contrat possibles par gestionnaires, on peut le tirer pour l'augmenter. )
 

Pièces jointes

Bonjour Axelle B, bienvenue sur XLD,

Voyez le fichier joint et ces macros (Alt+F11) :
VB:
Sub MAJ_feuilles()
Dim t, P As Range, nf$, d As Object, tablo, i&, a
t = Timer
Set P = Sheets("BDD").[C3].CurrentRegion 'à adapter
nf = UCase(P.Parent.Name)
'---liste des gestionnaires sans doublon---
Set d = CreateObject("Scripting.Dictionary")
tablo = P.Resize(, 2) 'matrice, plus rapide, au moins 2 éléments
For i = 2 To UBound(tablo)
    d(tablo(i, 1)) = ""
Next i
'---suppression des feuilles---
Application.ScreenUpdating = False
Application.DisplayAlerts = False
For i = Sheets.Count To 1 Step -1
    If UCase(Sheets(i).Name) <> nf Then Sheets(i).Delete
Next i
If d.Count = 0 Then Exit Sub
a = d.keys
tri a, 0, UBound(a) 'tri alphabétique
'---création des feuilles---
For i = 0 To UBound(a)
    Sheets.Add After:=Sheets(Sheets.Count)
    ActiveSheet.Name = a(i)
    P.AutoFilter 1, a(i) 'filtre automatique
    P.Copy ActiveSheet.[A1]
    ActiveSheet.Columns.AutoFit 'ajuste les largeurs
Next
P.AutoFilter 'ôte le filtre
Sheets(nf).Activate
MsgBox "Mise à jour des feuilles en " & Format(Timer - t, "0.00 \sec")
End Sub

Sub tri(a, gauc, droi) ' Quick sort
Dim ref, g, d, temp
ref = a((gauc + droi) \ 2)
g = gauc: d = droi
Do
    Do While a(g) < ref: g = g + 1: Loop
    Do While ref < a(d): d = d - 1: Loop
    If g <= d Then
      temp = a(g): a(g) = a(d): a(d) = temp
      g = g + 1: d = d - 1
    End If
Loop While g <= d
If g < droi Then Call tri(a, g, droi)
If gauc < d Then Call tri(a, gauc, d)
End Sub
Testée avec un tableau de 1000 lignes et 50 gestionnaires, la macro s'exécute chez moi en 1,5 seconde.

Edit : bonjour sylvanu.

A+
 

Pièces jointes

Dernière édition:
Bonjour Axelle B, bienvenue sur XLD,

Voyez le fichier joint et ces macros (Alt+F11) :
VB:
Sub MAJ_feuilles()
Dim t, P As Range, nf$, d As Object, tablo, i&, a
t = Timer
Set P = Sheets("BDD").[C3].CurrentRegion 'à adapter
nf = UCase(P.Parent.Name)
'---liste des gestionnaires sans doublon---
Set d = CreateObject("Scripting.Dictionary")
tablo = P.Resize(, 2) 'matrice, plus rapide, au moins 2 éléments
For i = 2 To UBound(tablo)
    d(tablo(i, 1)) = ""
Next i
'---suppression des feuilles---
Application.ScreenUpdating = False
Application.DisplayAlerts = False
For i = Sheets.Count To 1 Step -1
    If UCase(Sheets(i).Name) <> nf Then Sheets(i).Delete
Next i
If d.Count = 0 Then Exit Sub
a = d.keys
tri a, 0, UBound(a) 'tri alphabétique
'---création des feuilles---
For i = 0 To UBound(a)
    Sheets.Add After:=Sheets(Sheets.Count)
    ActiveSheet.Name = a(i)
    P.AutoFilter 1, a(i) 'filtre automatique
    P.Copy ActiveSheet.[A1]
    ActiveSheet.Columns.AutoFit 'ajuste les largeurs
Next
P.AutoFilter 'ôte le filtre
Sheets(nf).Activate
MsgBox "Mise à jour des feuilles en " & Format(Timer - t, "0.00 \sec")
End Sub

Sub tri(a, gauc, droi) ' Quick sort
Dim ref, g, d, temp
ref = a((gauc + droi) \ 2)
g = gauc: d = droi
Do
    Do While a(g) < ref: g = g + 1: Loop
    Do While ref < a(d): d = d - 1: Loop
    If g <= d Then
      temp = a(g): a(g) = a(d): a(d) = temp
      g = g + 1: d = d - 1
    End If
Loop While g <= d
If g < droi Then Call tri(a, g, droi)
If gauc < d Then Call tri(a, gauc, d)
End Sub
Testée avec un tableau de 1000 lignes et 50 gestionnaires, la macro s'exécute chez moi en 1,5 seconde.

Edit : bonjour sylvanu.

A+
Merci beaucoup de votre réponse rapide et de votre aide !!
 
Bonjour Axelle et bienvenu sur XLD,
Un essai en PJ. Par contre on doit dupliquer manuellement les feuilles, avec une par gestionnaire. Mais c'est fait une fois pour toute.
Une feuille doit porter le nom du gestionnaire, tel qu'apparaissant dans la liste.
En A2, on utilise le nom de la feuille comme critère de recherche, avec :
VB:
=DROITE(CELLULE("nomfichier";A1);NBCAR(CELLULE("nomfichier";A1))-TROUVE("]";CELLULE("nomfichier";A1)))
Puis pour la recherche proprement dite on utilise :
Code:
=SI(LIGNES($1:1)<=NB.SI(Feuil1!$C$4:$C$10000;AB!$A$2);INDEX(Feuil1!D$4:D$10;PETITE.VALEUR(SI(Feuil1!$C$4:$C$10000=Feuil1!Criteres;LIGNE(INDIRECT("1:"&LIGNES(Feuil1!$C$4:$C$10000))));LIGNES($1:1)));"")
Formule matricielle, donc à valider par Maj+Ctrl+Entrée.
( J'ai limité à 500 le nombre de contrat possibles par gestionnaires, on peut le tirer pour l'augmenter. )
Merci beaucoup de votre réponse rapide et de votre aide !
 
Notre forum d’entraide est 100 % gratuit et le restera.
Aucune formation payante, aucun fichier à acheter, rien à vendre. Mais comme tout site, nous devons couvrir nos frais pour continuer à vous accompagner.
Soutenez-nous en souscrivant à un compte membre : c’est rapide, vous choisissez simplement votre niveau de soutien et le tour est joué.

Je soutiens la communauté et j’accède à mon compte membre

Discussions similaires

Retour