Appliquer une macro à une selection

[Gerardd]

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

 

[job75]

Re : Appliquer une macro à une selection

Bonjour Gerardd, bienvenue sur XLD,

Normalement en VBA il est inutile de sélectionner les cellules.

Mais là je fais exception pour ne pas modifier d'un iota votre charmante macro

Donc compléter comme suit :

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
    [COLOR="Red"]'le corps de votre macro[/COLOR]
  End If
Next
End Sub

A+

 

[Gerardd]

Re : Appliquer une macro à une selection

Ca marche!

Ahlala et dire que j'ai galerer 3h dessus hier...

Merci!