Recherche d'adresse de colonne d'une variable tableau

Bonjour à tous les passionnés d'Excel,
Je cherche à récupérer l'adresse d'une cellule située dans un variable tableau et ainsi copier/coller les données (sans le nom du champ) de cette colonne sur une feuille dans la colonne correspondante avec le même nom de champ.
Je joins un fichier exemple.
- La liste des champs à traiter se situe sur la feuille 'Liste_Champs'
- Cette liste correspond à tous les champs non vides de la feuille 'Donnees_Source'
- Les données à copier sur la feuille 'Donnees_Source'
- La copie des données sur la feuille 'Resultat'
- Le décalage en ligne 12 sur la feuille résultat est volontaire.
Je me suis déjà bien fait aider par un membre actif du forum (Steelson, "Fanatique d'Excel" que je remercie encore) pour parvenir au fichier joint, mais je n'avais pas anticipé que si les colonnes de la feuille 'Donnees_Source' n'étaient pas dans le même ordre que celles de la feuille 'Resultat' le résultat n'est forcément pas bon.
En sachant que l'ordre des champs de la feuille 'Resultat' ne doit pas varier et ces champs ne sont pas touchés lors de la copie des données qui commence ligne 13.
Merci d'avance pour l'aide et les conseils que vous pourrez m'apporter.
Bien cordialement,
Dan

La macro utilisée dans le fichier joint est 'extraire_Final' correspondant au bouton '4.Final sans modifier entête'

Sub extraire_Final()
    ' Recopie toutes les colonnes de la feuille 'Donnees_Source' sur la feuille 'Resultat'
    ' y compris les colonnes vides, mais sans les entêtes
    ' Fonctionnement : teste tous les champs de la feuille 'Donnees_Source' et les compare à ceux contenus sur la feuille 'Liste_Champs'
    ' Pour les champs compatibles, rien n'est fait
    ' Pour les champs qui ne se trouvent pas sur la feuille 'Liste_Champs' l'ensemble des cellules de la colonne est vidée
    ' par le second For
Dim champs, entetes, donnees, col%, lig%, start, i%, j%, indic As Boolean

    start = Timer
    champs = Sheets("Liste_Champs").Range("B2").CurrentRegion
    entetes = Sheets("Donnees_source").Range("A1").CurrentRegion
    donnees = Sheets("Donnees_source").Range("A1").CurrentRegion.Offset(1, 0) 'Permet de ne traiter que les données et pas les entêtes de champs
    For col = UBound(entetes, 2) To 1 Step -1
        ' l'en-tête fait-elle partie de la liste ?
        indic = False
        For i = 2 To UBound(champs, 1)
            If champs(i, 1) = entetes(1, col) Then indic = True: Exit For
        Next
        ' si elle n'en fait pas partie ...
        If Not indic Then
            For i = 1 To UBound(donnees, 1)
                donnees(i, col) = ""
            Next
        End If
    Next
    Sheets("Resultat").Range("A12").CurrentRegion.Offset(1, 0).ClearContents
    Sheets("Resultat").Range("B13").Resize(UBound(donnees, 1), UBound(donnees, 2)) = donnees 'Ne contient pas les entêtes de champs
    MsgBox "Copie terminée - Durée du traitement : " & Timer - start & " secondes"

End Sub

Bonjour,

Je ne suis pas certain d'avoir compris. Ce que j'ai compris, c'est que vous cherchez, pour une cellule précise de Résultat à récupérer toute la colonne correspondante de Données Source.

Si je ne me suis pas trompé, je propose une macro qui se déclenche au double-clic sur la cellule en question :

'CODE A PLACER DANS LE MODULE DE LA FEUILLE RESULTAT
private sub worksheet_beforedoubleclick(byval target as range, cancel as boolean)
set r = intersect(target, range("A12").currentregion)
if not r is nothing then
    cancel = true
    call maj_colonne(target)
end if
end sub

'CODE A PLACER DANS UN MODULE NORMAL
Sub maj_colonne(Cible as range)

sChampDest = cells(12, Cible.column).value
if msgbox("Voulez-vous vraiment mettre à jour la colonne " & sChampDest & " ?", vbyesno) <> vbyes then exit sub

with Sheets("Donnees_source")
    colSrc = application.match(sChampDest, .rows(1), 0)
    dl = .cells(.rows.count, colSrc).end(xlup).row
    tchampSrc = .cells(2, colSrc).resize(dl - 1, 1).value
end with

with sheets("Resultat").cells(13, Cible.column)
    .resize(.currentregion.rows.count - 1, 1).clearcontents
    .Resize(UBound(tchampSrc), 1) = tchampSrc
end with

End Sub

Donc on double-clic sur une cellule de résultat, on en cherche le nom d'en-tête, on cherche la position de ce titre de colonne dans la feuille Donnees_source, on copie les valeurs de la colonne en question dans un tableau dynamique et on colle ce tableau dans la feuille Resultat.

Ici, je suppose que tous vos en-têtes sont identiques et qu'il n'est pas nécessaire d'en contrôler l'existence.

Cdlt,

Bonjour 3GB et merci pour cette proposition qui semble vraiment très sympa et facile d'utilisation.
Je me la mets de côté, car ça peut vraiment être utile.
En fait c'est plus simple que ça, il faut que toutes les colonnes non vides de la feuille 'Donnees_Source' dont les noms de champs correspondent à l'onglet 'Liste_Champs' soient mises à jour sur la feuille 'Resultat'.
Il faut considérer que la feuille 'Resultat' ne contient que la ligne 12 correspondant à la liste des champs.
Merci déjà pour cette proposition.
Dan

Bonjour 3GB,

J'ai effectué les modifications nécessaires pour que votre code s'applique à l'ensemble des colonnes concernées par le biais d'une boucle.
Il y a sûrement moyen de faire quelque chose de plus propre, mais ça fonctionne.
Merci encore pour la piste, les explications et l'exemple fournis.
Bien cordialement,
Dan

Sub Copie_donnees()
Dim colSrc As Integer, colDest As String, i As Integer
Dim dlLC As Integer, dlDS As Integer, nomChamp As String
Dim tchampSrc As Variant
Dim TrouveAdresse As String
Dim colListeChamps As Integer
Dim start
Dim Trouve As Range, PlageDeRecherche As Range
Dim Valeur_Cherchee As String, AdresseTrouvee As String

start = Timer
Application.ScreenUpdating = False
'Suppression des données précédentes
Call Nettoyage

With Sheets("Liste_Champs")
    colListeChamps = 2
    dlLC = .Cells(.Rows.Count, colListeChamps).End(xlUp).Row
End With

    For i = 3 To dlLC ' 3 = 1er champ de la feuille 'Liste_Champs'
        With Sheets("Liste_Champs")
            nomChamp = .Cells(i, colListeChamps)
        End With

With Sheets("Donnees_source")
    colSrc = Application.Match(nomChamp, .Rows(1), 0)
    dlDS = .Cells(.Rows.Count, colSrc).End(xlUp).Row
    If dlDS > 1 Then
        tchampSrc = .Cells(2, colSrc).Resize(dlDS - 1, 1).Value
    Else
        GoTo Fin
    End If
End With

Valeur_Cherchee = nomChamp 'On recherche le nom du champ sélectionné sur la feuille 'Liste_Champs'
Set PlageDeRecherche = Sheets("Resultat").Rows(12)

Set Trouve = PlageDeRecherche.Cells.Find(what:=Valeur_Cherchee, LookAt:=xlWhole)

TrouveAdresse = Trouve.Address
colDest = Split(TrouveAdresse, "$")(1)

With Sheets("Resultat").Cells(13, colDest)
    .Resize(.CurrentRegion.Rows.Count - 1, 1).ClearContents
    .Resize(UBound(tchampSrc), 1) = tchampSrc
End With
Fin:
    Next
Application.ScreenUpdating = True
    MsgBox "Copie terminée - Durée du traitement : " & Timer - start & " secondes"
End Sub

Bonsoir Dan,

Merci beaucoup pour ce retour ! Je suis désolé, j'ai regardé votre fichier, commencé à travailler dessus et y faire beaucoup de modifications (mettre les données sous forme de tableau structuré notamment). Finalement, je me suis dit qu'il y avait pas mal de macros et qu'il valait mieux attendre et les laisser ainsi car elles sont probablement mieux que ce que j'aurais pu proposer (notamment en terme de vitesse d'exécution, qui semblait vous préoccuper).

Et j'avoue ne pas avoir compris parfaitement ces différents imports.

En tout cas, je suis content que ça fonctionne. Merci encore pour ce retour !

Bonne soirée,