Discussion :

[nyto35]

Bonjour à tous,

Sous VBA, j'ai effectué une macro ayant pour but d'identifier les titres de colonnes et de les transférer dans une autre feuille de calcul.
Pour cela, j'ai créer un tableau de chaine de caractères à dimension fixe où pour chaque "case" du tableau il y a une chaine de caractères (un titre).
J'ai fais une boucle pour chaque "case" du tableau.

Ma macro marche correctement, le problème subsiste pour deux colonnes seulement.

En effet, pour la 1ère colonne que je veux transférer, son titre est "RB1".
Or la colonne juste avant a pour titre "S_RB1" et mon programme prend en compte le fait qu'il voir bien le titre "RB1" mais pas de la bonne colonne. Il transfert la colonne d'avant (titre "S-RB1").

Voici une partie de mon code:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
Public Sub Transfert()
 
   Dim FeuilleSari As Worksheet, FeuilleSortie As Worksheet, Cellule As Range
      Dim NumColonneSari As Long, NumColonneSortie As Long, Titre(8) As String, i As Byte
    Set FeuilleSari = Worksheets("Sari")
    Set FeuilleSortie = Worksheets("Sortie1")
    NumColonneSortie = 2   'numéro de colonne initial
 
  'Tableau des titres
    Titre(0) = "N__RENTE"
    Titre(1) = "BR"
    Titre(2) = "SIN_CONT"
    Titre(3) = "ETAT"
    Titre(4) = "DATE_SURV"
    Titre(5) = "NOM_TITU"
    Titre(6) = "PRE_TITU"
    Titre(7) = "DER_REG"
    Titre(8) = "RB1"
 
    'transfert des données
    For i = 0 To 8
        Set Cellule = FeuilleSari.Cells.Find(Titre(i))
        If Cellule Is Nothing Then
            MsgBox "Le titre n'a pas été trouvé"
        Else
            NumColonneSari = Cellule.Column
            FeuilleSari.Columns(NumColonneSari).Copy
            FeuilleSortie.Paste Destination:=FeuilleSortie.Columns(NumColonneSortie)
        End If
        NumColonneSortie = NumColonneSortie + 1
    Next i
End Sub

Cordialement

[Marc-L]

Bonjour.

En fin c'est normal vu ta ligne n° (ah zut, l'icône pour le code n'a pas été utilisée ‼)

Il suffit de consulter l'aide intégrée de VBA concernant les arguments de la méthode Find.

Au passage aussi pour la méthode Copy et son argument Destination …

Nb : indenter un code, cela donne bien plus l'envie de le lire …

[Invité]

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
Sub test()
Titre(0) = "N__RENTE"
Titre(1) = "BR"
Titre(2) = "SIN_CONT"
Titre(3) = "ETAT"
Titre(4) = "DATE_SURV"
Titre(5) = "NOM_TITU"
Titre(6) = "PRE_TITU"
Titre(7) = "DER_REG"
Titre(8) = "RB1"
 
Dim ColonneSari As New Collection
Dim NumColonneSortie As New Collection
NumColonneSortie.Add 1, "N__RENTE"
NumColonneSortie.Add 2, "BR"
NumColonneSortie.Add 3, "SIN_CONT"
NumColonneSortie.Add 4, "ETAT"
NumColonneSortie.Add 5, "DATE_SURV"
NumColonneSortie.Add 6, "NOM_TITU"
NumColonneSortie.Add 7, "PRE_TITU"
NumColonneSortie.Add 8, "DER_REG"
NumColonneSortie.Add 9, "RB1"
Dim MyRange As Range
Set MyRange = FeuilleSari.Range("A1").CurrentRegion
For c = 1 To MyRange.Columns.Count
    On Error Resume Next
    ColonneSari.Add c, MyRange(1, c)
    On Error GoTo 0
Next
'transfert des données
On Error Resume Next
For i = 0 To 8
 
NumColonneSari = ColonneSari("" & Titre(i))
If Err <> 0 Then
    MsgBox "Le titre n'a pas été trouvé"
Else
 FeuilleSari.Columns(NumColonneSari).Copy
    FeuilleSortie.Paste Destination:=FeuilleSortie.Columns(NumColonneSortie("" & Titre(i)))
End If
Err.Clear
Next i
On Error GoTo 0
End Sub

[nyto35]

Merci de vos réponses,

rdurupt tu me donnes un tout autre de code, cependant je ne comprend pas tout car je ne suis pas un "expert" en vba.

Lorsque j'exécute ton code, il y a une erreur au niveau de la ligne

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

NumColonneSari = FeuilleSari.Cells(1, NumColonneSari("" & Titre(i))).Column

Cela met :

Erreur de compilation, argument non facultatif

Y aurait-il un code plus "simple" et plus proche du mien qui puisse marcher car mon cela fonctionne sauf pour le problème que j'ai signalé plus haut.

[Invité]

exact,
j'ai modifié mais trop tard

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
Sub test()
Dim FeuilleSari As Worksheet, FeuilleSortie As Worksheet, Cellule As Range
Dim  NumColonneSortie As Long, Titre(8) As String, i As Byte
Set FeuilleSari = Worksheets("Sari")
Titre(0) = "N__RENTE"
Titre(1) = "BR"
Titre(2) = "SIN_CONT"
Titre(3) = "ETAT"
Titre(4) = "DATE_SURV"
Titre(5) = "NOM_TITU"
Titre(6) = "PRE_TITU"
Titre(7) = "DER_REG"
Titre(8) = "RB1"
 
Dim ColonneSari As New Collection
Dim NumColonneSortie As New Collection
NumColonneSortie.Add 1, "N__RENTE"
NumColonneSortie.Add 2, "BR"
NumColonneSortie.Add 3, "SIN_CONT"
NumColonneSortie.Add 4, "ETAT"
NumColonneSortie.Add 5, "DATE_SURV"
NumColonneSortie.Add 6, "NOM_TITU"
NumColonneSortie.Add 7, "PRE_TITU"
NumColonneSortie.Add 8, "DER_REG"
NumColonneSortie.Add 9, "RB1"
Dim MyRange As Range
Set MyRange = act.Range("A1").CurrentRegion
For c = 1 To MyRange.Columns.Count
    On Error Resume Next
    ColonneSari.Add c, MyRange(1, c)
    On Error GoTo 0
Next
'transfert des données
On Error Resume Next
For i = 0 To 8
 
NumColonneSari = ColonneSari("" & Titre(i))
If Err <> 0 Then
    MsgBox "Le titre n'a pas été trouvé"
Else
 FeuilleSari.Columns(NumColonneSari).Copy
    FeuilleSortie.Paste Destination:=FeuilleSortie.Columns(NumColonneSortie("" & Titre(i)))
End If
Err.Clear
Next i
On Error GoTo 0
End Sub

[Marc-L]

Y aurait-il un code plus "simple" et plus proche du mien qui puisse marcher

Il y a juste à compléter les arguments de la ligne Find comme dans l'aide et son exemple ‼

[nyto35]

Merci bien, j'ai finalement réussi en complétant les arguments de la méthode "find" malgré sa complexité !

[Marc-L]

Tant mieux !

Il y avait aussi l'astuce de le faire en manuel en cochant bien les options tout en utilisant l'enregistreur de macros …

Quelques améliorations possibles :

• utilisation d'Array ou Split pour le tableau avec une boucle For ... Each
• précision du titre dans le message
• copie en une seule ligne.