vba dupliquer certaines en-tête sur plusieurs tableaux sur une même feuille

[Fifi76]

bonjour,

je me permets de vous demander de l'aide après des jours de recherche … sans résultat

Pour un projet professionnel, je souhaiterais pouvoir dupliquer dans tous les tableaux d'une même page certaines en-tête de tableau

Le nombre de tableau peut varier
Le nombre de collaborateurs aussi (nombre de colonnes consacrées par les "collaborateurs" peut être fixe)
Le nombre de ligne par tableau évolue
La 1ere en-tête des tableaux varie d'un tableau à l'autre

Les en-têtes à dupliquer sont les Collab1,...
en précisant que les noms seront toujours en évolution

J'ai essayé avec une cellule active, mais trop contraignant … il peut y avoir 20-25 tableaux
J'ai un niveau très très débutante en vba

Merci beaucoup pour votre aide

 

[Dranreb]

Bonjour.
Sous réserve d'avoir compris ce qu'étaient les Collab1,… (j'ai estimé que c'était B9:AF9) :

Sub test()
Dim TEnt(), LOt As ListObject
TEnt = Feuil2.[B9:AF9].Value
For Each LOt In Feuil2.ListObjects
   LOt.HeaderRowRange(1, 2).Resize(, UBound(TEnt, 2)).Value = TEnt
   Next LOt
End Sub

 

[Fifi76]

merci beaucoup, c'est tout à fait ça !!
depuis le temps que je tourne en rond
juste une petite question, je vois le fonctionnement global
par contre pourquoi la référence de la feuille "Feuil2"?

 

[Dranreb]

C'est le nom de l'objet Worksheet de la rubrique Microsoft Excel Objets qui représente la feuille Excel nommée "Tâches Détaillées"
Moi je change toujours leur propriété Name en quelque chose de mnémonique commençant par "Wsh". Par exemple ici "WshTâchDét"
Certains parlent du CodeName de la feuille. Mais c'est un peu autre chose: c'est une propriété String qui reproduit le nom de l'objet Worksheet du projet VBA, qui la représente. Par exemple vous avez une feuille Excel nommée "Feuil2", et bien son CodeName vaut "Feuil6".

 

[job75]

Bonjour Fifi76, Bernard,

Voyez le fichier joint et cette macro dans Module1 :

Sub CopierEnTêtes()
Dim entetes As Range, ncolab%, c As Range, P As Range
Set entetes = Feuil2.[B9:AF9] 'à adapter
ncolab = 20 'nombre de collaborateurs, à adapter
For Each c In entetes(1).EntireColumn.SpecialCells(xlCellTypeConstants)
        If c.Orientation = xlUpward Then _
            Set P = Union(IIf(P Is Nothing, Intersect(entetes.EntireColumn, c.EntireRow), P), Intersect(entetes.EntireColumn, c.EntireRow))
Next
Application.ScreenUpdating = False
If Not P Is Nothing Then entetes.Copy P: P.Offset(, ncolab).Columns.AutoFit 'copier-coller et ajustement largeur
'---réglage du zoom---
entetes.Parent.Visible = xlSheetVisible 'si la feuille est masquée
Application.Goto entetes.Parent.[A1], True 'cadrage
entetes(1, 0).Resize(, entetes.Count + 1).Select
ActiveWindow.Zoom = True
entetes.Parent.[A1].Select
End Sub

Elle fonctionnera même si les tableaux ne sont pas organisés en tableaux Excel.

Les formats de la plage B9:AF9 sont copiés et les largeurs des colonnes de V9:AF9 sont ajustées.

Le zoom de la fenêtre est réglé sur la plage A9:AF9.

A+

 

[job75]

Re,

Votre macro dans Module2 nécessitait une révision :

Sub Macro_inserer_une_ligne()
'Touche de raccourci du clavier: Ctrl+a
If CStr([B2]) = "" Then Exit Sub
Dim c As Range
With Feuil2.[A:A]
    Set c = .Find(CStr([B2]), , xlValues, xlWhole)
    If c Is Nothing Then MsgBox "Activité introuvable en colonne A...": Exit Sub
    Set c = .Find("=", c, xlFormulas, xlPart) 'formule SOUS.TOTAL
End With
c.EntireRow.Insert
If IsNumeric(Right(c(-1), 1)) Then c(-1).AutoFill c(-1).Resize(2) 'incréméntation éventuelle
End Sub

Fichier (2)

A+

 

[Fifi76]

merci beaucoup de votre aide
cela fonctionne très bien, mais le document ne doit pas être zoomer, les colonnes ne doivent pas changer de taille
mais pour la 2eme macro, elle correspond exactement

 

[job75]

cela fonctionne très bien, mais le document ne doit pas être zoomer, les colonnes ne doivent pas changer de taille

Eh bien enlevez l'ajustement des largeurs et le réglage du zoom et voyez ce que ça donne.