BONJOUR
pour commencer je tiens à vous remercier pour votre aide .
j'essaie d'écrire une macro qui va me permettre de reporter directement les champs désignés sans ouverture du fichier cible.
je bloque quand je veux lancer la recherche sur le fichier cible .
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 Private Sub Worksheet_Change(ByVal Target As Range) Dim Ligne As Long Dim cible As String Dim Batch As Single Dim prs As String 'Vérifier si la cellule concernée par le changement fait partie de la plage F11:ED11 Set C = Application.Intersect(Target, Range("D4:D100")) If Not C Is Nothing And Target.Count = 1 Then 'stocker la cellule de la ligne changé de la colonne "A" afin de faire une recherche plutard Ligne = Target.Row cible = Range("A" & Ligne) prs = ("d" & Ligne) 'Test pour prendre la valeur de la colonne F si elle existe sinon on prend la valeur E 'If ("F" & ligne) Is Empty Then 'batch = ("E" & ligne) 'Else 'batch = ("F" & ligne) 'End If MsgBox "Le PRS Du Code Article " & cible & " Vient D'être Changée" 'stocker la valeur de la cellule changé dans une variable afin la reporter dans un autre classeur Call Test(Target.Value, Target.Column) End If End Sub Sub Test(cible, prs) Dim x As Long Dim Val As Range 'dans cette partie je veux écrire sans ouverture du fichier suivant 'Workbooks.Open Filename:="C:\Documents and Settings\FR22034\Bureau\mars\Quotationtemplate_Rev05.xlsm", IgnoreReadOnlyrecommended:=True, WriteResPassword:="pg" Fichier = Application.GetOpenFilename("Excel Files (*.xlsm),*.xlsm") Application.ScreenUpdating = False Application.DisplayAlerts = False If Fichier <> False Then Set Wbk = Workbooks.Open(Fichier) Application.DisplayAlerts = True With Wbk.Worksheets("Cables data") 'cette ligne provoque une erreur x = Application.Match(cible, Worksheets("Cables data").Columns("c:c"), 0) If x = 0 Then MsgBox "Code Article " & cible & " non trouvée." Else MsgBox "Le Code Article" & cible & "est dans la ligne: " & x 'ThisWorkbook.Worksheets("Cables data").Cells(x, 11).Value = Prs 'ThisWorkbook.Worksheets("Cables data").Cells(x, 12).Value = batch End If End With End If Wbk.Saved = True 'Wbk.Closed = True Set Wbk = Nothing End Sub
Partager