Bonjour à tous,
Débutant en VBA, j'essaie de créer une macro me permettant de copier des données d'un classeur et de les coller dans un autre.
Mon souhait est en effet que la macro parcourt une liste de code inscrit dans une ligne d'un classeur A et si elle les retrouve dans le classeur B, elle copie les données d'une plage définit sous le code du classeur B (soit dans la même colonne) et qu'elle les colle dans le classeur A dans la même colonne où le code est inscrit.
Mes plages de données à copier et coller ne varient pas en taille, seules l'emplacement des données et leur destination varient.
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 Sub Test_1() 'j'attribue un type aux paramètres que je vais utiliser Dim appExcel As Excel.Application 'Application Excel Dim wbExcel1, wbExcel2 As Excel.Workbook 'Classeur Excel Dim Feuil1, Feuil2 As Excel.Worksheet 'Feuille Excel Dim trouve As Range 'cellule ou plage de cellules Dim Repertoire As FileDialog Dim i, j, k As Integer 'j'indique à excel à quoi correspond feuil1 (celle où j'importe les données), soit celle que j'utilise en ce moment Set wbExcel1 = ActiveWorkbook Set Feuil1 = wbExcel1.ActiveSheet 'excel va ouvrir le répertoire et il va prendre le classeur que je sélectionne comme base de données Set Repertoire = Application.FileDialog(msoFileDialogFilePicker) Repertoire.Show 'Ouverture de l'application Rep = Repertoire.SelectedItems(1) 'sélection du classeur Set appExcel = CreateObject("Excel.Application") Set wbExcel2 = appExcel.Workbooks.Open(Rep) Set Feuil2 = wbExcel2.Sheets("PreconsoFC") 'attribution du nom Feuil2 à la feuille qui sert de base 'je rappatrie les données With Feuil2 For j = 4 To 50 Set trouve = wbExcel1.ActiveSheet.Rows(3).Cells.Find(.Cells(6, j), LookIn:=xlValues, LookAt:=xlWhole) ' si je trouve le même code If Not trouve Is Nothing Then .Range(Cells(91, trouve.Column), Cells(191, trouve.Column)).Select Selection.Copy Feuil1.Cells(j, 8).Select Selection.PasteSpecial Paste:=xlPasteValues End If Next j End With End Sub
Le code bug et je n'arrive pas à le débuger. Pourriez-vous s'il vous plaît m'aider ?
Partager