Bonjour,
J'ai taper 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 et une base de donnée. 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:
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??
Merci Beaucoup!!!
Gerard
J'ai taper 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 et une base de donnée. 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:
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??
Merci Beaucoup!!!
Gerard