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
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
| Sub Import_Donnees()
Dim Chemin_Dossier_Source As String
Dim Dossier_Source As String
Dim Numero_Page_Info As Integer
Dim Colonne1_fichier1 As Integer
Dim Colonne_de_Recherche1 As String
Dim Colonne_de_Recherche2 As Integer
Dim Page_Fichier2 As String
Dim Colonne1_fichier2 As Integer
''''''''''CHAMP A MODIFIER''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'''''(classeur1)'''''''''''''''''''''''''''''''''''''''''''''''''''''''
'Le chemin du fichier ou l'on va faire la recherche
Chemin_Dossier_Source = "C:\Users\Documents"
'Le nom du fichier ou l'on va faire la recherche
Dossier_Source = "\" & "Classeur1"
'Le Numéro de la feuille ou il y a les informations à prendre
'Pour exemple : Feuil2 (Nom_de_la_page) => 2
Numero_Page_Info = 1
'La colonne de recherche
'Pour exemple :"A" correspond à la colonne 1 || "B" correspond à la colonne 2'
Colonne_de_Recherche1 = "A"
'Pour ces info : la colonne "0" est la colonne de recherche
'Si les REF sont en colonne "C" et les infos à importer le sont en colonne "L", alors il faut mettre colonne1_fichier2 = 9'
Colonne1_fichier1 = 1
'''''Fin(classeur1)''''''''''''''''''''''''''''''''''''''''''''''''''''
'''''(classeur2)'''''''''''''''''''''''''''''''''''''''''''''''''''''''
'Le nom de la page à compléter et d'ou on recherche les REF
'Pour exemple : Feuil2 (Nom_de_la_page) => Nom_de_la_page
Page_Fichier2 = "Feuil1"
'La colonne des REF que l'on recherche
'1 correspond à "A" || 2 correspond à "B"'
Colonne_de_Recherche2 = 1
'Pour ces info : la colonne "0" est la colonne de recherche
'Si les REF sont en colonne "C" et la colonne à remplire est la "L", alors il faut mettre colonne1_fichier1 = 9'
Colonne1_fichier2 = 1
'''''Fin(classeur2)''''''''''''''''''''''''''''''''''''''''''''''''''''
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Dim fichier_existant As String
Dim fichier_existant_q As String
fichier_existant_q = Dir(Chemin_Dossier_Source & Dossier_Source)
fichier_existant = (Chemin_Dossier_Source & Dossier_Source)
If fichier_existant_q = "" Then
With Application
.ScreenUpdating = False
.Calculation = xlCalculationManual
End With
End If
Sheets(Page_Fichier2).Select
'Ouverture du fichier de prix (en caché)
Dim xlApp As Object
Set xlApp = CreateObject("Excel.Application")
Dim xlWk As Workbook
Set xlWk = xlApp.Workbooks.Open(Chemin_Dossier_Source & Dossier_Source)
Dim xlWs As Worksheet
Set xlWs = xlWk.Worksheets(Numero_Page_Info)
xlApp.Visible = True 'rend la deuxieme fenêtre visible
Dim rngArticle As Range
Dim myWS As Worksheet
Set myWS = ThisWorkbook.ActiveSheet
DerLig = myWS.Cells(Rows.Count, Colonne_de_Recherche2).End(xlUp).Row
Set rngArticle = myWS.Range(myWS.Cells(1, Colonne_de_Recherche2), myWS.Cells(DerLig, Colonne_de_Recherche2))
'Recherche de l'article dans l'autre fichier
Dim rngArticleRecherche As Range
'ICI LA COLONNE RECHERCHE
Set rngArticleRecherche = xlWs.Range(xlWs.Range(Colonne_de_Recherche1 & "1"), xlWs.Range(Colonne_de_Recherche1 & "65536").End(xlUp))
Dim rngRefTrouve As Range
Dim cell As Range
For Each cell In rngArticle
Set rngRefTrouve = rngArticleRecherche.Find(cell.Value, , xlValues, xlWhole)
If rngRefTrouve Is Nothing Then
Else
'MsgBox cell.Value
cell.Offset(, Colonne1_fichier2).Value = rngRefTrouve.Offset(, Colonne1_fichier1).Value 'prix
End If
Next
'Libération des ressources (fermeture du fichier caché)
Set xlWs = Nothing
xlWk.Close (False)
Set xlWk = Nothing
xlApp.Quit
Set xlApp = Nothing
With Application
.ScreenUpdating = True
.Calculation = xlCalculationAutomatic
End With
End Sub |
Macro d'import de données selon ref qui ne fonctionne pas
Répondre avec citation
Partager