XL 2010 Sélection de colonnes et remplacement du titre de colonnes

[KIM]

Bonjour le forum, bonjour les ami(e)s,
Je reviens vers vous pour éviter, grâce à avec votre aide, les actions répétitives avec excel. Je reçois tous les mois une extraction de notre SI et la recopie dans l'onglet BaseO (Base origine). les titres des colonnes sont toujours les mêmes par contre l'ordre des colonnes ou le nombre de colonnes risque de changer d'une extraction à une autre. Je recopie manuellement les colonnes à traiter dans l'onglet BaseT et modifie les titres pour les rendre plus lisibles. C'est l'onglet BaseT qui est à l'origine de plusieurs tableaux de synthèse.
Est-il possible, en vba,
- de lister les titres des colonnes de l'onglet BaseO,
- d'attribuer un numéro d'ordre pour les colonnes sélectionnées, voir l'exemple Base_modèle ,
- remplacer les titres des colonnes sélectionnées
- et copier les données de ces colonnes sélectionnées dans l'ordre souhaité dans l'onglet BaseT?
Ci-joint le fichier de test.
Je vous remercie de votre aide.
KIM

 

[vgendron]

Hello

essaie avec ce code

Sub extract()
Dim ListCol()
With Sheets("BaseT")
     nb = Cells(8, .Range("8:8").Columns.Count).End(xlToLeft).Column
     ReDim ListCol(nb, 1)
     
    For i = 1 To nb 'on récupère les numéros de colonnes à extraire de BaseO ainsi que leur nom simplifié
        ListCol(i, 0) = Cells(8, i)
        ListCol(i, 1) = Cells(9, i) 'inutile je pense..
    Next i
End With

TailleColonne = Sheets("BaseO").Range("A" & Rows.Count).End(xlUp).Row 'taille des colonnes à importer
For i = 1 To nb
    With Sheets("BaseO")
        .Cells(7, ListCol(i, 0)).Resize(TailleColonne - 7).Copy Destination:=Sheets("BaseT").Cells(10, i)
    End With
Next i

End Sub

 

[KIM]

Bonjour vgendron, bonjour les ami(e)s,
@vgendron,
Merci pour ta macro. Elle fonctionne à condition de saisir les données des lignes 8 et 9 de la feuille BaseT. Cela me fait gagner la moitié du chemin. Le but final est de préciser ces données dans la code vba. de rechercher les titres dans la BaseO, leur attribuer l'ordre souhaité de BaseTet les nouveaux titres ligne 9 de la BaseT, d'effacer la BaseT et de recopier les colonnes sélectionnées.
PS : Les titres des colonnes de la BaseO sont figés, ne varient pas, mais ne sont pas dans le même ordre d'une extraction à une autre.
Est-ce possible?
Merci d'avance
KIM

 

[vgendron]

j'ai pas tout compris de quelles infos tu saisis et à quel endroit.

avec ceci ?
en ligne 7: liste de validation qui permet de choisir directement un nom dans les noms existants en BaseO
tu mets donc ceux que tu veux dans l'ordre que tu souhaites
en ligne 9, tu laisses ou modifies les nouveaux noms..

 

[KIM]

Merci vgendron, ta macro fonctionne. Il faut au préalable saisir la ligne 7 et la ligne 9 dans BaseT. Un gain de temps important.
Je reprend mon idée principale. Dis moi si c'est possible d'intégrer la ligne 7 dans le code vba. Par exemple : pour "DEL.Code Département"
-Je recherche dans ligne 6 de BaseO le titre "DEL.Code Département"
- j'identifie son num colonne dans BaseO
- je lui attribue le num colonne "1" dans BaseT
- et un nouveau titre "DPT"
- Ensuite je recopie la colonne identifiée de "DEL.Code Département" dans BaseT, col "1" à partir de la ligne 9 et lui attribue le nouveau titre "DPT"
Idem pour les autres colonnes de BaseT.
Cela permet d'avoir tout dans le code vba. Est-ce possible ?
Merci d'avance
KIM

 

[vgendron]

bon bah.... avec ceci alors..
si je comprend bien.. tout est décrit en dur dans la macro..
les entetes simplifiés ainsi que l'ordre final des colonnes..

Sub extract()
Const NbCol = 11 'nombre de colonnes à extraire
Dim ListCol(NbCol, 2)
ListCol(1, 1) = "DEL.Code Département": ListCol(1, 2) = "DPT"
ListCol(2, 1) = "SIT.Code Site Dpt": ListCol(2, 2) = "SIT"
ListCol(3, 1) = "SIT.Code compte": ListCol(3, 2) = "CPT"
ListCol(4, 1) = "SIT.Code compte SRC": ListCol(4, 2) = "SRC"
ListCol(5, 1) = "BAT.Régime type Statut": ListCol(5, 2) = "STAT"
ListCol(6, 1) = "BAT.Code Bâtiment Dpt": ListCol(6, 2) = "BAT"
ListCol(7, 1) = "BAT.SHON": ListCol(7, 2) = "SHON"
ListCol(8, 1) = "BAT.SUB": ListCol(8, 2) = "SUB"
ListCol(9, 1) = "BAT.SUN": ListCol(9, 2) = "SUN"
ListCol(10, 1) = "Année construction": ListCol(10, 2) = "An.construction"
ListCol(11, 1) = "Date de  réhabilitation": ListCol(11, 2) = "Date Réha."

With Sheets("BaseT")
    .Range("A9").CurrentRegion.Offset(1, 0).ClearContents
     'nb = Cells(7, .Range("7:7").Columns.Count).End(xlToLeft).Column
     'ReDim ListCol(nb, 1)
     
    For i = 1 To NbCol 'on récupère les numéros de colonnes à extraire de BaseO
        With Sheets("BaseO")
            Set c = .Rows("6:6").Find(ListCol(i, 1))
            If Not c Is Nothing Then
                ListCol(i, 0) = c.Column
            End If
        End With
    Next i
End With

TailleColonne = Sheets("BaseO").Range("A" & Rows.Count).End(xlUp).Row 'taille des colonnes à importer
For i = 1 To NbCol
    With Sheets("BaseO")
        .Cells(7, ListCol(i, 0)).Resize(TailleColonne - 7).Copy Destination:=Sheets("BaseT").Cells(10, i)
        Sheets("BaseT").Cells(9, i) = ListCol(i, 2)
    End With
Next i

End Sub

 

[ChTi160]

Bonjour KIM
Bonjour le vgendron ,Le Fil ,Le Forum
Content de pouvoir te Saluer !
histoire de participer Lol

Si j'ai bien compris , tu sélectionnes les Entêtes de colonnes en feuille "BaseT" Ligne "7" et ensuite tu lances la modification de ces entêtes et le Transfert des Données ?

Bonne Journée à vous
Amicalement
Jean marie

 

[KIM]

Merci vgendron, la macro fonctionne très bien. J'ai seulement modifié la copie
.Cells(7, ListCol(i, 0)).Resize(TailleColonne - 6).Copy au lieu de -7 car la dernière ligne de Base0 n'est pas copiée.
Merci encore
KIM

 

[KIM]

Bonjour Jean marie, vgendron,
@jean marie,
Toujours fidèle à ce forum et disponible. Toujours content de te retrouver.
C'était l'idée proposée par vgendron, de sélectionnes les Entêtes de colonnes en feuille "BaseT" Ligne "7" et ensuite de lanceer la modification de ces entêtes et le Transfert des Données.
De ma part, et pour allèger le tableau, j'ai souhaité saisir en dur les titres souhaités dans la macro, et les recopier dans BaseT selon un ordre défini dans la macro et les nouveaux titres. c'était la dernière proposition de vgendron.

Pour améliorer l'exploitation de cette dernière macro, comment gérer les messages d'erreurs quand la macro ne retrouvent pas le titre dans BaseO ligne 6?
Merci encore de votre aide.
KIM

 

[ChTi160]

Re
ai je bien compris ?
Dans la feuille "BaseT" , les entêtes seront toujours dans le même ordre ?
Seuls les entêtes de la feuille "BaseO" , peuvent être dans un ordre Différent lors de L'import ?
On pourrait alors envisager en adaptant le tableau de vgendron
Mettre le Numéro de Colonne Cible dans le Tableau :

Dim ListCol(NbCol, 3)
ListCol(1, 1) = "DEL.Code Département": ListCol(1, 2) = "DPT": ListCol(1, 3) = 1
ListCol(2, 1) = "SIT.Code Site Dpt": ListCol(2, 2) = "SIT": ListCol(2, 3) = 2
etc

en espérant avoir pu faire avancer le Schimilimblick LOL

PS :Qu'entends tu par ne retrouve pas le titre dans BaseO ligne 6
il devrait y être et n'y est pas ?
s'il te plait des exemples de ce qui peut arriver , pourquoi ?
et ce que tu veux faire dans ce cas .
Bonne journée
Amicalement
Jean marie

 

[KIM]

Re les amis,
@jean marie,
1/ Oui, c'est une bonne idée de mettre le num de colonne cible dans le tableau. Je vais tester.
2/ 2 cas possible pour les erreurs :
a: L'extraction mensuelle peut ne pas être complète. Il manque une ou plusieurs colonnes dont j'ai besoin dans BaseT.
b : Ou bien, dans la macro Extract, la macro ne troube pas la colonne dans BaseO à cause d'une erreur de saisie dans la macro.
Dans ces 2 cas la macro ne trouve pas la col recherchée dans BaseO.
Comment intégrer un message à l'écran pour dire que la ou les colonnes demandées (liste le nom de la col non trouvée dans BaseT ligne 6 ?
Merci d'avance
KIM

 

[ChTi160]

Re
un exemple de ce que j'ai proposé en adaptant le fichier de vgendron

je regarde , mais je vais attendre des nouvelles , de vgendron
Bonne journée
Amicalement
Jean marie

 

[vgendron]

Hello le fil !

dans le cas d'un ou plusieurs intitulés absents, tu peux sans utiliser un msgbox

Option Explicit
Option Base 1
Public ListCol() As Variant
Public DerLgn As Long
Public i As Byte
Public Lgn As Byte
Public c As Range
Public ColCible As Byte
Public ColSource As Byte

Sub extract()
'*****************
  Recup_Tab  'On va récupérer le tableau des Entêtes et Lignes prédéfinis
'*****************
Application.ScreenUpdating = False
Sheets("BaseT").Range("A9").CurrentRegion.ClearContents 'On efface les données présentent
With Sheets("BaseO") 'Avec la feuille
      DerLgn = .Cells(.Rows.Count, 1).End(xlUp).Row
     
    For i = 1 To UBound(ListCol, 1) 'on récupère les numéros de colonnes à extraire de BaseO
       
            Set c = .Rows("6:6").Find(ListCol(i, 1)) 'On recherhe l'entete en ligne 6
            If Not c Is Nothing Then 'Si trouvé
                ColCible = CByte(ListCol(i, 3)) 'On récupére le Numero de la colonne Cible "Feuille BaseT"
                ColSource = c.Column 'On récupére le Numero de la colonne Source "Feuille BaseO"

                Sheets("BaseT").Cells(9, ColCible) = ListCol(i, 2) 'On colle l'entête abrege
                .Cells(7, ColSource).Resize(DerLgn).Copy Destination:=Sheets("BaseT").Cells(10, ColCible) 'On colle les donnees de la colonne ainsi définie
            Else
                CodeAbsent = ListCol(i, 1) & ";" & CodeAbsent
            End If
    Next i
End With
Application.ScreenUpdating = True
If CodeAbsent <> "" Then MsgBox ("les intitulés de colonnes suivants n'ont pas été trouvés:") & Chr(10) & CodeAbsent

End Sub
Public Function Recup_Tab()
ReDim Preserve ListCol(11, 4)
ListCol(1, 1) = "Test": ListCol(1, 2) = "DPT": ListCol(1, 3) = 1: ListCol(1, 4) = ""
'ListCol(1, 1) = "DEL.Code Département": ListCol(1, 2) = "DPT": ListCol(1, 3) = 1: ListCol(1, 4) = ""
ListCol(2, 1) = "SIT.Code Site Dpt": ListCol(2, 2) = "SIT": ListCol(2, 3) = 2: ListCol(2, 4) = ""
ListCol(3, 1) = "SIT.Code compte": ListCol(3, 2) = "CPT": ListCol(3, 3) = 3: ListCol(3, 4) = ""
ListCol(4, 1) = "SIT.Code compte SRC": ListCol(4, 2) = "SRC": ListCol(4, 3) = 4: ListCol(4, 4) = ""
ListCol(5, 1) = "BAT.Régime type Statut": ListCol(5, 2) = "STAT": ListCol(5, 3) = 5: ListCol(5, 4) = ""
ListCol(6, 1) = "BAT.Code Bâtiment Dpt": ListCol(6, 2) = "BAT": ListCol(6, 3) = 6: ListCol(6, 4) = ""
ListCol(7, 1) = "BAT.SHON": ListCol(7, 2) = "SHON": ListCol(7, 3) = 7: ListCol(7, 4) = ""
ListCol(8, 1) = "BAT.SUB": ListCol(8, 2) = "SUB": ListCol(8, 3) = 8: ListCol(8, 4) = ""
ListCol(9, 1) = "BAT.SUN": ListCol(9, 2) = "SUN": ListCol(9, 3) = 9: ListCol(9, 4) = ""
ListCol(10, 1) = "Année construction": ListCol(10, 2) = "An.construction": ListCol(10, 3) = 10: ListCol(10, 4) = ""
ListCol(11, 1) = "Date de  réhabilitation": ListCol(11, 2) = "Date Réha.": ListCol(11, 3) = 11: ListCol(11, 4) = ""
End Function

 

[ChTi160]

Re
Une adaptation qui tiens compte des erreurs éventuelles (Voir exemple dans entêtes et Tableau) .
Bonne fin de Journée
Amicalement
Jean marie

 

[KIM]

Merci les amis, Jean marie & Vgendron.
Vos macros focntionnent très bien. J'ai seulement rajouter "Public CodeAbsent As String"
dans la version de vgendron.
Merci à vous deux, comme d'habitude efficace et pertinent.
Bonne fin de journée
KIM