Discussion :

[Gerardd]

Bonjour,

J'ai tapé le code d'une macro qui s'applique sur une cellule (je selectionne la cellule puis j'appuie sur le raccourci) et maintenant j'aimerai pouvoir appliquer cette macro à une selection.

L'utilité de la macro: on a une feuille de travail(appelé PetitVRD) et une base de donnée(appelée installchant). La base de donnée contient des désignations de travaux avec les unités. A chaque désignation correspond un code. A la place de taper toute la désignation, la personne a juste à taper le code et à utiliser la macro qui remplace alors le code par la désignation et l'unité dans la cases à coté.

Voila 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
Option Explicit
 
Public PetitVRD As Worksheet, installchant 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() '
 
Set PetitVRD = ThisWorkbook.Worksheets("Petit VRD")
Set installchant = ThisWorkbook.Worksheets("Installation de chantier")
 
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
 
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
' I = MsgBox("La référence n'a pas été trouvée dans la base", vbOKOnly, "DQE")
 
Else
Licop = Champ.Row
.Range(.Cells(Licop, 3), .Cells(Licop, 4)).Copy Destination:=PetitVRD.Cells(Licol, 2)
Calle.Offset(0, 1).Value = Champ.Offset(0, 3)
Calle.Offset(0, 2).Value = Champ.Offset(0, 4)
Calle.Offset(0, 3).Value = Champ.Offset(0, 5)
Calle.Offset(0, 4).Value = Champ.Offset(0, 6)
End If
End With 
PetitVRD.Activate
Set Calle = Nothing
Set Champ = Nothing
Set PetitVRD = Nothing
Set installchant = Nothing
 
 
End Sub

===> Voila le code, comment faire pour que cette macro s'applique sur toute une selection de cellules??

Merci Beaucoup!!!

Gerard

[JackIsJack]

Salut,

En modifiant 3 lignes de ton code, tu peux faire en sorte que ta macro s'applique à ta selection (qu'il s'agisse d'une ou plusieurs cellules selectionnés)
Voici le code modifié :

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
 
 
Option Explicit
 
Public PetitVRD As Worksheet, installchant 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() '
 
 
 
Set PetitVRD = ThisWorkbook.Worksheets("Petit VRD")
Set installchant = ThisWorkbook.Worksheets("Installation de chantier")
 
 
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
 
LiAnc = 4: LiFin = 500
 
For each Calle in Selection   
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
' I = MsgBox("La référence n'a pas été trouvée dans la base", vbOKOnly, "DQE")
 
Else
Licop = Champ.Row
.Range(.Cells(Licop, 3), .Cells(Licop, 4)).Copy Destination:=PetitVRD.Cells(Licol, 2)
Calle.Offset(0, 1).Value = Champ.Offset(0, 3)
Calle.Offset(0, 2).Value = Champ.Offset(0, 4)
Calle.Offset(0, 3).Value = Champ.Offset(0, 5)
Calle.Offset(0, 4).Value = Champ.Offset(0, 6)
End If
End With 
PetitVRD.Activate
Set Calle = Nothing
Set Champ = Nothing
Set PetitVRD = Nothing
Set installchant = Nothing
Next Calle 
 
End Sub