Discussion :

[Gerardd]

Bonjour,


J’ai une macro qui, lorsqu’on va taper un code dans une cellule va chercher la désignation y correspondant dans des onglets (tjrs pour la rédaction de devis).
Pour l’instant j’ai réussi à l’appliquer sur une sélection de cellule. Mais maintenant mon chef souhaiterai que la macro s’applique dès qu’on tape le code (il ne veut plus qu’on fasse control+A sur une sélection de cellule).
Les codes vont de 1 000 à 11 000. Pour info, voici le 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
Option Explicit
 
Public PetitVRD As Worksheet, installchant As Worksheet, travauxprepa As Worksheet,
Public I As Integer, J As Integer, k As Integer
Dim Licop As Integer, Licol As Integer, LiAnc As Integer, LiFin As Integer, LiOrg As Integer
Public Code As String, Un As String
Public Champ As Range, Calle As Range
Public Ach As String
 
 
 
Public Sub CopieLigne()
 
Dim plage As Range, cel As Range
Set plage = Intersect(selection, Columns(selection.Column), ActiveSheet.UsedRange)
If plage Is Nothing Then Exit Sub
Application.ScreenUpdating = False
For Each cel In plage
  If cel <> "" Then
    cel.Activate
 
 
 
    Set PetitVRD = ThisWorkbook.Worksheets("Petit VRD")
    Set installchant = ThisWorkbook.Worksheets("Installation de chantier")
    Set travauxprepa = ThisWorkbook.Worksheets("travaux préparatoires")
 
 
 
    If ActiveSheet.Name = installchant.Name Then
        I = MsgBox("Cette fonction ne s'applique pas dans la feuille Installation de chantier", vbOKOnly, "PetitVRD")
        Exit Sub
    End If
 
    If ActiveSheet.Name = travauxprepa.Name Then
        I = MsgBox("Cette fonction ne s'applique pas dans la feuille Travaux préparatoires", vbOKOnly, "PetitVRD")
        Exit Sub
    End If
 
 
    LiAnc = 4: LiFin = 500
 
 
    Set Calle = ActiveCell
    Code = Calle.Value
    Un = Calle.Offset(0, 1).Value
    Licol = Calle.Row
    With installchant
        Set Champ = .Range(.Cells(LiAnc, 1), .Cells(LiFin, 1)).Find(what:=Code, LookIn:=xlValues, lookat:=xlWhole, SearchOrder:=xlByColumns)
        If Champ Is Nothing Then
 
        With travauxprepa
        Set Champ = .Range(.Cells(LiAnc, 1), .Cells(LiFin, 1)).Find(what:=Code, LookIn:=xlValues, lookat:=xlWhole, SearchOrder:=xlByColumns)
        If Champ Is Nothing Then
 
 
        Else
            Licop = Champ.Row
            .Range(.Cells(Licop, 3), .Cells(Licop, 7)).Copy Destination:=PetitVRD.Cells(Licol, 2)
 
            End If
    End With
 
 
        Else
            Licop = Champ.Row
            .Range(.Cells(Licop, 3), .Cells(Licop, 7)).Copy Destination:=PetitVRD.Cells(Licol, 2)
        End If
    End With
 
 
    PetitVRD.Activate
    Set Calle = Nothing
    Set Champ = Nothing
    Set PetitVRD = Nothing
    Set installchant = Nothing
    Set travauxterr = Nothing
 
    End If
Next
 
End Sub

[zyhack]

Bonjour

essaye,

dans le code de la feuille

Code :

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

1
2
3
Private Sub Worksheet_Change(ByVal Target As Range)
Call CopieLigne(Target)
End Sub

et modifier ton code comme ceci

Code :

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

1
2
3
4
5
6
 
Public Sub CopieLigne(cellule)
 
Dim plage As Range, cel As Range
Set plage = Intersect(cellule, Columns(cellule.Column), ActiveSheet.UsedRange)
...