XL 2016 alimenter des onglets en fonction du nom figurant en colonne G

[eastwick]

Bonjour à toutes et tous,
Souci VBA bien pointu.
Je caresse l'espoir d'obtenir un code VBA via Userform (ou autre) qui va m'alimenter au fur et à mesure toute l'année les onglets dont le nom se retrouve dans la colonne G de "planning".
Cependant, la récupération des données doit se faire selon le modèle mis en B1C1M1 en jaune (concaténation de certaines données).
Le tableau planning va évoluer en nombre de lignes, 12 lignes par jour, pour info.
Un grand merci pour ce travail dont l'accomplissement reste pour moi chimérique.
P.S. : les matrices me font ramer grave, j'ai déjà essayé.

 

[Jacky67]

Merci Jacky67, Chris

Re..
Pourquoi tant de haine envers les dates ???

 

[job75]

Bonjour eastwick, chris, Jacky67,

Voyez le fichier joint et cette macro dans ThisWorkbook :

Private Sub Workbook_SheetActivate(ByVal Sh As Object)
Dim lig&, r As Range
Application.ScreenUpdating = False
With Sheets("planning")
    If Sh.Name = .Name Then Exit Sub
    .[A:K].AutoFilter 7, Sh.Name 'filtre automatique
    lig = 2
    For Each r In .AutoFilter.Range.SpecialCells(xlCellTypeVisible).Rows
        Sh.Cells(lig, 1) = r.Cells(1).MergeArea(1)
        Sh.Cells(lig, 2) = r.Cells(3)
        Sh.Cells(lig, 3) = r.Cells(8)
        Sh.Cells(lig, 4) = r.Cells(9)
        lig = lig + 1
    Next
    .[A:K].AutoFilter 'RAZ
End With
Sh.Range("A" & lig & ":D" & Sh.Rows.Count).ClearContents 'RAZ en dessous
Sh.[A:A].NumberFormat = "dddd dd/mm/yyyy"
End Sub

Elle se déclenche quand on active une feuille autre que "planning".

Les cellules fusionnées ne posent aucun problème.

A+

 

[eastwick]

Merci Job75, je réitère toute mon admiration et mes remerciements pour ce forum qui nous apporte des solutions bureautiques bénévolement, et tout ceci nous facilite grandement la vie, la professionnelle pour le moins ! Donc encore merci et chapeau à ce groupe TOTALEMENT indispensable

 

[eastwick]

Merci Job75

 

[job75]

Oui il ne faut pas masquer la colonne G qui contient les critères de filtrage.

 

[job75]

Pour tester j'ai recopié le tableau A2:K25 sur 96 000 lignes.

La macro s'exécute chez moi en 3 secondes, c'est tout à fait satisfaisant.

 

[mapomme]

Bonsoir à @eastwick , @chris , @Jacky67 ,@job75 ,

Juste pour le fun, une version avec un tableau.

Private Sub Workbook_SheetActivate(ByVal Sh As Object)
Dim t, BCM, n&, i&, deb!
   deb = Timer
   Application.ScreenUpdating = False
   With Sheets("planning")
      If Sh.Name = .Name Then Exit Sub
      If .FilterMode Then .ShowAllData
      t = .Range("a1").Resize(.Cells(.Rows.Count, "g").End(xlUp).Row, 9)
   End With
   i = 1: t(i, 2) = t(i, 3): t(i, 3) = t(i, 8): t(i, 4) = t(i, 9):  BCM = Sh.Name: n = n + 1
   For i = 2 To UBound(t)
      If t(i, 1) = "" Then t(i, 1) = t(i - 1, 1)
      If t(i, 7) = BCM Then n = n + 1: t(n, 1) = t(i, 1): t(n, 2) = t(i, 3): t(n, 3) = t(i, 8): t(n, 4) = t(i, 9)
   Next i
   With Sh
      .Range(.Range("a2"), .Cells(.Rows.Count, 5)).ClearContents
      .Range("a2").Resize(n, 4) = t
   End With
   MsgBox Format(Timer - deb, "0.000\ sec.")
End Sub

 

[job75]

Bonsoir mapomme,

Oui les solutions par tableaux VBA sont généralement les plus rapides :

Private Sub Workbook_SheetActivate(ByVal Sh As Object)
Dim tablo, critere$, i&, n&, dat
With Sheets("planning")
    If Sh.Name = .Name Then Exit Sub
    If .FilterMode Then .ShowAllData 'si la feuille est filtrée
    tablo = .Range("A1:I" & .Range("G" & .Rows.Count).End(xlUp).Row).Value2 'matrice, plus rapide
End With
critere = UCase(Sh.Name)
For i = 2 To UBound(tablo)
    If UCase(tablo(i, 7)) = critere Then
        n = n + 1
        If tablo(i, 1) <> "" Then dat = tablo(i, 1)
        tablo(n, 1) = dat: tablo(n, 2) = tablo(i, 3): tablo(n, 3) = tablo(i, 8): tablo(n, 4) = tablo(i, 9)
    End If
Next
'---restitution---
If Sh.FilterMode Then Sh.ShowAllData 'si la feuille est filtrée
Sh.[A:A].NumberFormat = "dddd dd/mm/yyyy" 'au cas où
With Sh.[A3] '1ère cellule de destination, à adapter
    If n Then .Resize(n, 4) = tablo
    .Offset(n).Resize(Sh.Rows.Count - n - .Row + 1, 4).ClearContents 'RAZ en dessous
End With
End Sub

Sur 96 000 lignes => 0,14 seconde chez moi.

A+

 

[eastwick]

Merci beaucoup à tous

 

[eastwick]

Bonjour à toutes et tous,
Je reviens vers vous, hélas, suite à la connaissance de nouvelles infos. 2 nouveaux onglets sont à ajouter qui s'appelleront TPG et API, ce même nom se retrouvera en colonne G de l'onglet planning. Ainsi les onglets TPG et API récupèreront leurs renseignement spécifiques de la même façon que que les autres onglets (B1C1M1 etc) à savoir sur 4 colonnes. Merci de ce que vous pourrez faire et navré de vous solliciter à nouveau...

 

[mapomme]

Bonjour @eastwick ,

Il suffit de rajouter deux onglets dont l'un s'appelle TPG et l'autre API, non ?

 

[job75]

Bonjour eastwick, mapomme,

Une solution est d'introduire la colonne supplémentaire "TPG/API" avec cette formule en H2 :

=SI(OU(D2="";E2="";F2="");REPT(G2;OU(G2="TPG";G2="API"));CONCATENER("B";D2;"C";E2;"M";F2))

Remplacer aussi 7, 8, 9 par 8, 9, 10 dans la macro.

A+

 

[eastwick]

Merci, j'ai trouvé. Effectivement l'ajout d'onglets API et TPG fonctionne.
Formule en G : =SI(D3="API";"API";SI(D3="TPG";"TPG";SI(OU(D3="";E3="";F3="");"";CONCATENER("B";D3;"C";E3;"M";F3))))
Ainsi, pas besoin de colonne supplémentaire.
Encore merci pour votre aide précieuse.

 

[job75]

Ainsi, pas besoin de colonne supplémentaire.

D'accord mais alors la colonne D n'est plus réservée à "bloc".

Et il vaut mieux écrire en G2 :

=SI(OU(D2="TPG";D2="API");D2;REPT(CONCATENER("B";D2;"C";E2;"M";F2);NON(NB.SI(D2:F2;""))))

 

[eastwick]

Merci job75. Je reviendrai vers vous prochainement car je souhaite perfectionner ce fichier en calculant le nombre d'heures annuelles par onglet. Ce qui implique de rajouter des colonnes heure de début heure de fin et donc durée... J'ai bien essayé en solo mais lamentable résultat...