Macro qui copie une colonne selon son entête vers une autre colonne ayant la même

Version imprimable

24/09/2014, 18h36
TonyBennett

Macro qui copie une colonne selon son entête vers une autre colonne ayant la même

Bonjour!

Je me débrouille plutôt bien en excel mais en VBA, c'est case départ.

Je veux écrire une macro qui copie une colonne selon son entête (données créées par formule et variables) dans une autre colonne du fichier portant la même entête (si l'entête est "1", je veux que la sélection de données se recopie sous l'autre entête "1", une seule fois et en valeurs).

La partie copier-coller.valeurs, ça va (merci enregistreur), c'est le volet test identifier la variable au haut de la colonne "données" et trouver la bonne entête dans mon range de destination qui ne jazz pas.

Quelqu'un a une piste de solution?

Merci!
24/09/2014, 19h50
Philippe Tulliez

Bonjour,
D'après tes explications, il semble que tu auras une réponse dans cette contribution LookupLabelRange - Ajouter une colonne à une liste de données

Bonjour,

une solution est d'utiliser une collection pour mémoriser les entêtes de ta feuille résultat .. :

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
Option Explicit
Dim cColDest As Collection
Dim shDest As Worksheet
 
'
' Mémorisation numéro de colonne
'
Sub InitCollection()
    Dim i As Integer
 
 
    Set shDest = ThisWorkbook.Worksheets("Feuil3") ' A ADAPTER
 
    Set cColDest = New Collection
 
    i = 1
    While shDest.Cells(1, i) <> ""
        On Error Resume Next
            cColDest.Add i, shDest.Cells(1, i)
            If Err.Number <> 0 Then 'On considére qu'il n'y as pas de doublon dans colone dest
                Debug.Print "Doublon colonne " & i & " : " & shDest.Cells(1, i)
            End If
            i = i + 1
     Wend
 
End Sub
'
' Dépose valeur dans feuille destination
'
Function PoseValeur(stEntete As String, MaValeur) As Boolean
 Dim iC As Integer
 Dim iDerLigne As Long
    On Error Resume Next
    iC = cColDest(stEntete)
 
    If iC = 0 Or Err.Number <> 0 Then
        Debug.Print "Erreur Entête " & stEntete & " Introuvable"
        PoseValeur = False
        Exit Function
    End If
    On Error GoTo 0
 
    iDerLigne = shDest.Cells(shDest.Rows.Count, iC).End(xlUp).Row + 1
    shDest.Cells(iDerLigne, iC).Value = MaValeur
     PoseValeur = True
End Function
 
 
'
' FONCTION DE TEST ....
'
Sub MaMAcro()
    InitCollection
    Debug.Print PoseValeur("Nom", "AjoutDansColNOM")
    Debug.Print PoseValeur("Adresse", "AjoutDansColonne  Adresse")
 
 
End Sub

24/09/2014, 21h29
TonyBennett

Merci!

J'ai regardé les deux solutions, mais cela me semble bien complexe pour une opération semblable (et pour mon niveau, mettons l'orgueil de côté).

Ma colonne avec les données est toujours la même (disons P), avec une entête numérotée 1 à 12 (nombre généré par une autre feuille) et selon ce nombre, je dois aller la recoller dans une des 12 colonnes destinations, elles aussi numérotées 1 à 12 (disons de C à N).

Bonjour,

Une piste à adapter :

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
 
Sub Test()
 
    Dim Plage As Range
    Dim Cel As Range
    Dim Entete As Integer
 
    'pour le test
    Entete = 3
 
    'la plage d'entêtes en définie dans la première ligne de la feuille "Feuil2"
    With Worksheets("Feuil2")
 
        Set Plage = .Range(.Cells(1, 1), .Cells(1, .Columns.Count).End(xlToLeft))
 
    End With
 
    'recherche l'entête de colonne
    Set Cel = Plage.Find(Entete, , xlValues, xlWhole)
 
    'si trouvée, copie
    If Not Cel Is Nothing Then
 
        Worksheets("Feuil1").Columns(Entete).Copy Cel
 
    End If
 
End Sub

Hervé.

25/09/2014, 21h04
TonyBennett

Bon, en étudiant tout ça, je devrais pouvoir bricoler quelque chose!

Je vous remercie tous! :-)