VBA récupérer des données dans différentes cellules sur fichier A pour coller sur fichier B

**Jam97** · 28/03/2024, 23h29

Bonjour,

Je suis novice sur la programmation de VBA.

J'ai créer ce programme avec l'aide de Youtube et je comprends pas pourquoi il bloque au niveau du texte en rouge.

Pouvez-vous m'aider svp ?

Je dois générer ce fichier souvent pour l'exporter vers mon fichier de travail

Merci par avance pour votre aide

Sub copier_coller_celluleA1_fichier2feuil1()

Dim wk_fichier As Workbook
Dim ws_fichier1feuil1 As Worksheet

Dim wk_fichier2 As Workbook
Dim ws_fichier2feuil1 As Worksheet

Dim der_ligne_1 As Long
Dim der_ligne_2 As Long

'définir les variables fichiers et onglets
Set wk_fichier = ActiveWorkbook
Set ws_fichier1feuil1 = wk_fichier.Worksheets(1)

Set wk_fichier2 = Application.Workbooks.Open("C:\Users\Jam\Desktop\Tableau JAM macro\EXTRACTION declaration-2023-04-20_11-58.xlsx")
Set ws_fichier2feuil1 = wk_fichier2.Worksheets(1)

'copier coller une plage de cellule

ws_fichier1feuil1.Range(ws_feuil1.Cells(2, 1), ws_feuil1.Cells(der_ligne_1, 2)).Copy ws_fichier2feuil1.Cells(der_ligne_2 + 1, 1)

'enregistrer et fermer fichier 2
wk_fichier2.Close (True)

End Sub

**laurent_ott** · 29/03/2024, 09h27

Envoyé par Jam97

je comprends pas pourquoi il bloque au niveau du texte en rouge.

Bonjour,
Peut-être parce que "ws_feuil1" n'existe pas, c'est "ws_fichier1feuil1" qu'il faudrait utiliser.
Et que "der_ligne_1" et "der_ligne_2" sont à zéro car non renseignées.
Et peut-être d'autres choses que je n'ai pas vu.

**deedolith** · 29/03/2024, 11h49

Salut,

Note:
Renomme tes variables, en utilisant des noms plus lisibles et plus parlant.
Ca évitera ce genre d'erreur à l'avenir.

De plus, compile ton code,
le compilateur est ton ami et sera le premier à te signaler ces anomalies.

**Jam97** · 04/04/2024, 18h57

Merci pour vos réponses j'ai trouvé mon erreur. (Laurent_ott et deedolith)

'identifier dernière ligne de la feuil1
der_ligne_1 = ws_fichier2feuil1.Cells(Rows.Count, 1).End(xlUp).Row

'copier coller une plage de cellule

ws_fichier2feuil1.Range(ws_fichier2feuil1.Cells(2, 1), ws_fichier2feuil1.Cells(der_ligne_1, 1)).Copy ws_fichier1feuil1.Cells(der_ligne_2 + 2, 2)

J'avais oublié d'identifier ma dernière ligne et Laurent_ott avait raison, je me suis trompé quand j'ai nommé mes fichiers.

J'ai une deuxième soucis à régler.

Je voudrais coller seulement les valeurs. Je suis bloqué pour utiliser la fonction PasteSpecial

Avez-vous une idée svp ?

**Franc** · 04/04/2024, 20h02

Bonjour, voici la syntaxe pour coller uniquement les valeurs: ws_fichier1feuil1.Cells(der_ligne_2 + 2, 2).PasteSpecial Paste:=xlPasteValues

**Jam97** · 05/04/2024, 20h48

Envoyé par Franc

Bonjour, voici la syntaxe pour coller uniquement les valeurs: ws_fichier1feuil1.Cells(der_ligne_2 + 2, 2).PasteSpecial Paste:=xlPasteValues

Bonjour,

Merci pour votre retour mais le système m'indique "Erreur de compilation : Attendu : fin d'instruction "

Avez-vous une idée pour résoudre cette erreur svp ?

**Franc** · 05/04/2024, 20h56

Envoyé par Jam97

Bonjour,

Merci pour votre retour mais le système m'indique "Erreur de compilation : Attendu : fin d'instruction "

Avez-vous une idée pour résoudre cette erreur svp ?

J'ai modifié ta macro avec l'instruction que je t'ai fournie pour copier/coller et la compilation s'exécute sans erreur.
A moins que tu aies modifié ta macro par rapport à celle que tu as fournie, je ne vois pas où est le problème, il n'y a que des Dim, Set et 2 lignes de code.

**Valtrase** · 06/04/2024, 14h44

Bonjour,
A tester comme ceci :

Code :

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

1
2
ws_fichier2feuil1.Range(ws_fichier2feuil1.Cells(2, 1),  ws_fichier2feuil1.Cells(der_ligne_1, 1)).Copy
ws_fichier1feuil1.Cells(der_ligne_2 + 2, 2).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False

**Jam97** · 08/04/2024, 10h33

Envoyé par Franc

J'ai modifié ta macro avec l'instruction que je t'ai fournie pour copier/coller et la compilation s'exécute sans erreur.
A moins que tu aies modifié ta macro par rapport à celle que tu as fournie, je ne vois pas où est le problème, il n'y a que des Dim, Set et 2 lignes de code.

Non j'ai rien modifié.

**Jam97** · 08/04/2024, 10h40

Envoyé par Valtrase

Bonjour,
A tester comme ceci :

Code :

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

1
2
ws_fichier2feuil1.Range(ws_fichier2feuil1.Cells(2, 1),  ws_fichier2feuil1.Cells(der_ligne_1, 1)).Copy
ws_fichier1feuil1.Cells(der_ligne_2 + 2, 2).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False

Merci cela fonctionne sur les premières lignes mais à partir de la ligne en rouge cela bloque

Option Explicit

Sub copier_coller_cellule_fichier2feuil1()

Dim wk_fichier As Workbook
Dim ws_fichier1feuil1 As Worksheet

Dim wk_fichier2 As Workbook
Dim ws_fichier2feuil1 As Worksheet

Dim der_ligne_1 As Long
Dim der_ligne_2 As Long

'définir les variables fichiers et onglets
Set wk_fichier = ActiveWorkbook
Set ws_fichier1feuil1 = wk_fichier.Worksheets(1)

Set wk_fichier2 = Application.Workbooks.Open("C:\Users\JAM97\Desktop\ETP Tableau JAM macro\EXTRACTION declaration-programme-etp_2023-04-20_11-58.xlsx")
Set ws_fichier2feuil1 = wk_fichier2.Worksheets(1)

'identifier dernière ligne de la feuil1
der_ligne_1 = ws_fichier2feuil1.Cells(Rows.Count, 1).End(xlUp).Row

'copier coller une plage de cellule

ws_fichier2feuil1.Range(ws_fichier2feuil1.Cells(2, 1), ws_fichier2feuil1.Cells(der_ligne_1, 1)).Copy
ws_fichier1feuil1.Cells(der_ligne_2 + 2, 2).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
ws_fichier2feuil1.Range(ws_fichier2feuil1.Cells(2, 40), ws_fichier2feuil1.Cells(der_ligne_1, 40)).Copy
ws_fichier1feuil1.Cells(der_ligne_2 + 2, 5).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
ws_fichier2feuil1.Range(ws_fichier2feuil1.Cells(2, 44), ws_fichier2feuil1.Cells(der_ligne_1, 44)).Copy
ws_fichier1feuil1.Cells(der_ligne_2 + 2, 6).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
ws_fichier2feuil1.Range(ws_fichier2feuil1.Cells(2, 41), ws_fichier2feuil1.Cells(der_ligne_1, 41)).Copy
ws_fichier1feuil1.Cells(der_ligne_2 + 2, 8).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
ws_fichier2feuil1.Range(ws_fichier2feuil1.Cells(2, 18), ws_fichier2feuil1.Cells(der_ligne_1, 18)).Copy
ws_fichier1feuil1.Cells(der_ligne_2 + 2, 10).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
ws_fichier2feuil1.Range(ws_fichier2feuil1.Cells(2, 16), ws_fichier2feuil1.Cells(der_ligne_1, 16)).Copy
ws_fichier1feuil1.Cells(der_ligne_2 + 2, 13).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
ws_fichier2feuil1.Range(ws_fichier2feuil1.Cells(2, 19), ws_fichier2feuil1.Cells(der_ligne_1, 19)).Copy
ws_fichier1feuil1.Cells(der_ligne_2 + 2, 14).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
ws_fichier2feuil1.Range(ws_fichier2feuil1.Cells(2, 26), ws_fichier2feuil1.Cells(der_ligne_1, 26)).Copy
ws_fichier1feuil1.Cells(der_ligne_2 + 2, 16).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
ws_fichier2feuil1.Range(ws_fichier2feuil1.Cells(2, 28), ws_fichier2feuil1.Cells(der_ligne_1, 28)).Copy
ws_fichier1feuil1.Cells(der_ligne_2 + 2, 17).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
ws_fichier2feuil1.Range(ws_fichier2feuil1.Cells(2, 29), ws_fichier2feuil1.Cells(der_ligne_1, 29)).Copy
ws_fichier1feuil1.Cells(der_ligne_2 + 2, 18).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
ws_fichier2feuil1.Range(ws_fichier2feuil1.Cells(2, 20), ws_fichier2feuil1.Cells(der_ligne_1, 20)).Copy
ws_fichier1feuil1.Cells(der_ligne_2 + 2, 19).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
ws_fichier2feuil1.Range(ws_fichier2feuil1.Cells(2, 21), ws_fichier2feuil1.Cells(der_ligne_1, 21)).Copy
ws_fichier1feuil1.Cells(der_ligne_2 + 2, 21).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
ws_fichier2feuil1.Range(ws_fichier2feuil1.Cells(2, 22), ws_fichier2feuil1.Cells(der_ligne_1, 22)).Copy
ws_fichier1feuil1.Cells(der_ligne_2 + 2, 22).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
ws_fichier2feuil1.Range(ws_fichier2feuil1.Cells(2, 2), ws_fichier2feuil1.Cells(der_ligne_1, 2)).Copy
ws_fichier1feuil1.Cells(der_ligne_2 + 2, 24).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
ws_fichier2feuil1.Range(ws_fichier2feuil1.Cells(2, 9), ws_fichier2feuil1.Cells(der_ligne_1, 9)).Copy
ws_fichier1feuil1.Cells(der_ligne_2 + 2, 27).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False

'enregistrer et fermer fichier 2
wk_fichier2.Close (True)

End Sub

**deedolith** · 08/04/2024, 12h03

Ne serait-ce pas mieux de passer par Power Query ?

**Valtrase** · 08/04/2024, 12h11

Bonjour,

Ça bloque, n'est pas très explicite, non ?

Quel est le message d'erreur ? Si message d'erreur il y a.

**Jam97** · 08/04/2024, 13h14

Envoyé par Valtrase

Bonjour,

Ça bloque, n'est pas très explicite, non ?

Quel est le message d'erreur ? Si message d'erreur il y a.

J'ai fermé et re-tester et cela fonctionne

L'erreur etait sur "Débogage"

**Jam97** · 08/04/2024, 14h05

Envoyé par deedolith

Ne serait-ce pas mieux de passer par Power Query ?

Je ne connais pas, Je vais tester la prochaine fois.

**Franc** · 08/04/2024, 14h10

Salut, ce qui me semble étrange c'est que tu déclares la variable Dim der_ligne_2 As Long mais tu ne lui affectes aucune valeur dans ta macro, ça ne pose pas de problème ? Quoi qu'il en soit, j'ai modifié la macro pour éviter les répétitions. Si tu veux tester:

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
Sub copier_coller_cellule_fichier2feuil1()
 
Dim wk_fichier As Workbook
Dim ws_fichier1feuil1 As Worksheet
 
Dim wk_fichier2 As Workbook
Dim ws_fichier2feuil1 As Worksheet
 
Dim der_ligne_1 As Long
Dim der_ligne_2 As Long
 
'définir les variables fichiers et onglets
Set wk_fichier = ActiveWorkbook
Set ws_fichier1feuil1 = wk_fichier.Worksheets(1)
 
Set wk_fichier2 = Application.Workbooks.Open("C:\Users\JAM97\Desktop\ETP Tableau JAM macro\EXTRACTION declaration-programme-etp_2023-04-20_11-58.xlsx")
Set ws_fichier2feuil1 = wk_fichier2.Worksheets(1)
 
'identifier dernière ligne de la feuil1
der_ligne_1 = ws_fichier2feuil1.Cells(Rows.Count, 1).End(xlUp).Row
der_ligne_2 = ws_fichier1feuil1.Cells(Rows.Count, 1).End(xlUp).Row
 
'copier coller une plage de cellule
Dim source_columns As Variant
Dim target_columns As Variant
 
source_columns = Array(1, 40, 44, 41, 18, 16, 19, 26, 28, 29, 20, 21, 22, 2, 9)
target_columns = Array(2, 5, 6, 8, 10, 13, 14, 16, 17, 18, 19, 21, 22, 24, 27)
 
For i = 0 To UBound(source_columns)
    ws_fichier2feuil1.Range(ws_fichier2feuil1.Cells(2, source_columns(i)), ws_fichier2feuil1.Cells(der_ligne_1, source_columns(i))).Copy
    ws_fichier1feuil1.Cells(der_ligne_2 + 2, target_columns(i)).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Next i
 
'enregistrer et fermer fichier 2
wk_fichier2.Close (True)
 
End Sub

**Valtrase** · 08/04/2024, 16h35

Bonjour,
@Franc

ce qui me semble étrange c'est que tu déclares la variable Dim der_ligne_2 As Long mais tu ne lui affectes aucune valeur dans ta macro

Son tableau doit commencer à la deuxième ligne, puis est incrémenté de deux à chaque fois.

Code :

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

ws_fichier1feuil1.Cells(der_ligne_2 + 2, 2).PasteSpecial ...

Donc der_ligne_2 est presque la première...

**Jam97** · 09/04/2024, 18h40

Envoyé par Franc

Salut, ce qui me semble étrange c'est que tu déclares la variable Dim der_ligne_2 As Long mais tu ne lui affectes aucune valeur dans ta macro, ça ne pose pas de problème ? Quoi qu'il en soit, j'ai modifié la macro pour éviter les répétitions. Si tu veux tester:

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
Sub copier_coller_cellule_fichier2feuil1()
 
Dim wk_fichier As Workbook
Dim ws_fichier1feuil1 As Worksheet
 
Dim wk_fichier2 As Workbook
Dim ws_fichier2feuil1 As Worksheet
 
Dim der_ligne_1 As Long
Dim der_ligne_2 As Long
 
'définir les variables fichiers et onglets
Set wk_fichier = ActiveWorkbook
Set ws_fichier1feuil1 = wk_fichier.Worksheets(1)
 
Set wk_fichier2 = Application.Workbooks.Open("C:\Users\JAM97\Desktop\ETP Tableau JAM macro\EXTRACTION declaration-programme-etp_2023-04-20_11-58.xlsx")
Set ws_fichier2feuil1 = wk_fichier2.Worksheets(1)
 
'identifier dernière ligne de la feuil1
der_ligne_1 = ws_fichier2feuil1.Cells(Rows.Count, 1).End(xlUp).Row
der_ligne_2 = ws_fichier1feuil1.Cells(Rows.Count, 1).End(xlUp).Row
 
'copier coller une plage de cellule
Dim source_columns As Variant
Dim target_columns As Variant
 
source_columns = Array(1, 40, 44, 41, 18, 16, 19, 26, 28, 29, 20, 21, 22, 2, 9)
target_columns = Array(2, 5, 6, 8, 10, 13, 14, 16, 17, 18, 19, 21, 22, 24, 27)
 
For i = 0 To UBound(source_columns)
    ws_fichier2feuil1.Range(ws_fichier2feuil1.Cells(2, source_columns(i)), ws_fichier2feuil1.Cells(der_ligne_1, source_columns(i))).Copy
    ws_fichier1feuil1.Cells(der_ligne_2 + 2, target_columns(i)).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Next i
 
'enregistrer et fermer fichier 2
wk_fichier2.Close (True)
 
End Sub

Merci, j'ai tester et j'ai un message d'erreur : "Erreur de compilation : Variable non définie" : celle de i

**Franc** · 09/04/2024, 20h25

Envoyé par Jam97

Merci, j'ai tester et j'ai un message d'erreur : "Erreur de compilation : Variable non définie" : celle de i

Il suffit de le déclarer, par exemple Dim i as Byte

**Jam97** · 11/04/2024, 11h33

Envoyé par Franc

Il suffit de le déclarer, par exemple Dim i as Byte

Merci c'est bon.

Elle fonctionne, mais j'ai elle m'efface les données déjà copier de mon dossier d'origine

et je voudrais aussi : concatener deux cellules dans la même avec la macro VBA que tu m'a donné je dois faire comment stp ?

VBA récupérer des données dans différentes cellules sur fichier A pour coller sur fichier B

Macros et VBA Excel

Discussions similaires

Partager

Partager