Bouche pour copier des lignes

**NamanNacedo** · 04/09/2018, 14h02

Bonjour à toutes et à tous,

Je commence en VBA, et j'ai besoin d'aide.
Je souhaite créer un module VBA capable de me copier les lignes d'un fichier A vers un fichier B puis de me copier certaines données d'un fichier C vers mon fichier B en fonction des données déjà copier de mon fichier A. Par exemple une fois les lignes de mon fichier A copier (comprenons Nom, Prénom...) lors du passage au fichier C, je souhaite que cela check mon fichier B pour voir la correspondance Nom/Prénom (ces données sont aussi dans mon fichier C) lorsqu'il y a correspondance, cela doit copier sur la même ligne dans la bonne colonne la donnée souhaité du fichier C.

Pour le moment j'en suis encore à la première partie au je copie les lignes de mon fichier A vers mon fichier B, le soucis, c'est que cela me copie bien la première ligne mais ensuite cela me décale la copie de mon fichier A, cela me copie les mauvaise casse, ou il y a rien dedans.
Voici 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
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
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
 
Sub fusion()
 
Dim Fichier, WbCopy As Workbook, WbkColle As Workbook
Dim Colonnes(), Col As Integer, Resultat As Variant
 
 
Set WbColle = Workbooks.Open("/Users/Test.xlsx")
Sheets("Feuil1").Select
 
'nom des entetes de colonnes à importer
Colonnes = Array("Nom", "Prénom", "ID", "E-mail", "Téléphone portable", "Téléphone domicile", "Téléphone au travail")
 
Fichier = "/Users/Mailing_List.xlsx"
 
Set WbCopy = Workbooks.Open("/Users/Mailing_List.xlsx")
Sheets("Mailing_List").Select
 
With WbCopy.Sheets("Mailing_List")
For i = 1 To 5
'Boucle sur toutes les entêtes des colonnes
For Col = 1 To 7 
 
'selectionne la première colonne
If Col = 1 Then     'Nom
       'casse du dessous
    ActiveCell.Offset(i, 0).Select
       'Copié - Collé 
    Application.CutCopyMode = False
    Selection.Copy
   With WbColle.Sheets("Feuil1").Cells(i, 6).Offset(1, 0)
   .PasteSpecial xlPasteValues
   End With
End If
 
 
If Col = 2 Then     'Prénom
    ActiveCell.Offset(0, 1).Select
        Application.CutCopyMode = False
    Selection.Copy
    With WbColle.Sheets("Feuil1").Cells(i, 5).Offset(1, 0)
       .PasteSpecial xlPasteValues
   End With
End If
 
 
If Col = 4 Then     'Email
    ActiveCell.Offset(0, 3).Select
        Application.CutCopyMode = False
    Selection.Copy
    With WbColle.Sheets("Feuil1").Cells(i, 15).Offset(1, 0)
       .PasteSpecial xlPasteValues
   End With
End If
 
If Col = 5 Then     'Portable
    ActiveCell.Offset(0, 1).Select
        Application.CutCopyMode = False
    Selection.Copy
    With WbColle.Sheets("Feuil1").Cells(i, 13).Offset(1, 0)
       .PasteSpecial xlPasteValues
   End With
End If
 
If Col = 6 Then     'téléphone domicile
    ActiveCell.Offset(0, 1).Select
        Application.CutCopyMode = False
    Selection.Copy
    With WbColle.Sheets("Feuil1").Cells(i, 11).Offset(1, 0)
       .PasteSpecial xlPasteValues
   End With
End If
 
If Col = 7 Then     'téléphone travail
    ActiveCell.Offset(0, 1).Select
        Application.CutCopyMode = False
    Selection.Copy
    With WbColle.Sheets("Feuil1").Cells(i, 12).Offset(1, 0)
       .PasteSpecial xlPasteValues
   End With
End If
 
Next Col
Next
 
    End With
 
  Set WbCopy = Nothing
Set WbColle = Nothing
End Sub

Je sais que le code n'est pas très propre et peut être optimisé mais voila ce que j'ai réussi a faire jusqu'a présent. Merci de votre aide pour cette première étape.

**Igloobel** · 04/09/2018, 14h22

Envoyé par NamanNacedo

Bonjour à toutes et à tous,

Je commence en VBA, et j'ai besoin d'aide.
Je souhaite créer un module VBA capable de me copier les lignes d'un fichier A vers un fichier B puis de me copier certaines données d'un fichier C vers mon fichier B en fonction des données déjà copier de mon fichier A. Par exemple une fois les lignes de mon fichier A copier (comprenons Nom, Prénom...) lors du passage au fichier C, je souhaite que cela check mon fichier B pour voir la correspondance Nom/Prénom (ces données sont aussi dans mon fichier C) lorsqu'il y a correspondance, cela doit copier sur la même ligne dans la bonne colonne la donnée souhaité du fichier C.

Pour le moment j'en suis encore à la première partie au je copie les lignes de mon fichier A vers mon fichier B, le soucis, c'est que cela me copie bien la première ligne mais ensuite cela me décale la copie de mon fichier A, cela me copie les mauvaise casse, ou il y a rien dedans.
Voici 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
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
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
 
Sub fusion()
 
Dim Fichier, WbCopy As Workbook, WbkColle As Workbook
Dim Colonnes(), Col As Integer, Resultat As Variant
 
 
Set WbColle = Workbooks.Open("/Users/Test.xlsx")
Sheets("Feuil1").Select
 
'nom des entetes de colonnes à importer
Colonnes = Array("Nom", "Prénom", "ID", "E-mail", "Téléphone portable", "Téléphone domicile", "Téléphone au travail")
 
Fichier = "/Users/Mailing_List.xlsx"
 
Set WbCopy = Workbooks.Open("/Users/Mailing_List.xlsx")
Sheets("Mailing_List").Select
 
With WbCopy.Sheets("Mailing_List")
For i = 1 To 5
'Boucle sur toutes les entêtes des colonnes
For Col = 1 To 7 
 
'selectionne la première colonne
If Col = 1 Then     'Nom
       'casse du dessous
    ActiveCell.Offset(i, 0).Select
       'Copié - Collé 
    Application.CutCopyMode = False
    Selection.Copy
   With WbColle.Sheets("Feuil1").Cells(i, 6).Offset(1, 0)
   .PasteSpecial xlPasteValues
   End With
End If
 
 
If Col = 2 Then     'Prénom
    ActiveCell.Offset(0, 1).Select
        Application.CutCopyMode = False
    Selection.Copy
    With WbColle.Sheets("Feuil1").Cells(i, 5).Offset(1, 0)
       .PasteSpecial xlPasteValues
   End With
End If
 
 
If Col = 4 Then     'Email
    ActiveCell.Offset(0, 3).Select
        Application.CutCopyMode = False
    Selection.Copy
    With WbColle.Sheets("Feuil1").Cells(i, 15).Offset(1, 0)
       .PasteSpecial xlPasteValues
   End With
End If
 
If Col = 5 Then     'Portable
    ActiveCell.Offset(0, 1).Select
        Application.CutCopyMode = False
    Selection.Copy
    With WbColle.Sheets("Feuil1").Cells(i, 13).Offset(1, 0)
       .PasteSpecial xlPasteValues
   End With
End If
 
If Col = 6 Then     'téléphone domicile
    ActiveCell.Offset(0, 1).Select
        Application.CutCopyMode = False
    Selection.Copy
    With WbColle.Sheets("Feuil1").Cells(i, 11).Offset(1, 0)
       .PasteSpecial xlPasteValues
   End With
End If
 
If Col = 7 Then     'téléphone travail
    ActiveCell.Offset(0, 1).Select
        Application.CutCopyMode = False
    Selection.Copy
    With WbColle.Sheets("Feuil1").Cells(i, 12).Offset(1, 0)
       .PasteSpecial xlPasteValues
   End With
End If
 
Next Col
Next
 
    End With
 
  Set WbCopy = Nothing
Set WbColle = Nothing
End Sub

Je sais que le code n'est pas très propre et peut être optimisé mais voila ce que j'ai réussi a faire jusqu'a présent. Merci de votre aide pour cette première étape.

Bonjour,

Effectivement tu as besoin d'aide ... surtout pour structuré ton programme.

d'abord tes If dans ton For c'est bizarre

donc quand tu fais : FOR Col = 1 to 7 .... NEXT

il va passé forcément le 1 puis le 2 , le 3 ... le 7 et il changera automatiquement la valeur de COL à chaque Next

donc il te faut qu'un seul test dedans

de plus il n'est pas utile de sélectionner la cellule pour y copier quelque chose

Peux-tu faire une capture écran de la structure de ton fichier ( en cachant les données sensibles) pour mieux comprendre ta problématique

**NamanNacedo** · 04/09/2018, 15h13

Merci de ta réponse.

Voici la capture d'écran:
Fichier A
Nom : Capture d’écran 2018-09-04 à 14.11.09.png
Affichages : 117
Taille : 12,2 Ko

Fichier B

Nom : Capture d’écran 2018-09-05 à 09.11.25.png
Affichages : 110
Taille : 14,7 Ko

**NamanNacedo** · 05/09/2018, 10h14

J'ai essayé de retirer mes if, mais lorsque je fais ca, cela ne change pas de colonne à chaque next mais de ligne.

**Igloobel** · 05/09/2018, 13h06

Bonjour,

Peux-tu compléter les correspondance entre le fichier A et B

Fic. Fic
A--------B
________
colonnes
A---->----F
B---->----E
C---->----?
D---->----A
E---->----O
F---->----?
G---->----?
H---->----?

**NamanNacedo** · 05/09/2018, 15h18

colonnes
A---->----F
B---->----E
D---->----A
E---->----O
F---->----M
G---->----K
H---->----L

Les autres je n'en ai pas besoin pour le moment.

Bouche pour copier des lignes

Macros et VBA Excel

Vue hybride

Discussions similaires

Partager

Partager