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

[Axelle B]

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

 

[sylvanu]

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 :

=DROITE(CELLULE("nomfichier";A1);NBCAR(CELLULE("nomfichier";A1))-TROUVE("]";CELLULE("nomfichier";A1)))

Puis pour la recherche proprement dite on utilise :

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

 

[job75]

Bonjour Axelle B, bienvenue sur XLD,

Voyez le fichier joint et ces macros (Alt+F11) :

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+

 

[Axelle B]

Bonjour Axelle B, bienvenue sur XLD,

Voyez le fichier joint et ces macros (Alt+F11) :

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

 

[Axelle B]

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 :

=DROITE(CELLULE("nomfichier";A1);NBCAR(CELLULE("nomfichier";A1))-TROUVE("]";CELLULE("nomfichier";A1)))

Puis pour la recherche proprement dite on utilise :

=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 !