formule à vérifier

pierre4

XLDnaute Occasionnel
bonjour,
j'ai cette formule (aidé par le forum.)
dès que je clique sur l'onglet concerné elle se me en route,

1/ que dois je modifier dedans pour l'activer uniquement quand je le souhaite...via une touche raccourci(cela je sais faire)

2/ y a t il une erreur?
- dans "devis" seules les colonnes C&D fonctionnent bien elles reportent bien de "ouvrages" D:D et G:G ; mais pas L:L ...à P:p...pourquoi?

merci de vos lumières.
Pierre

Private Sub Workbook_SheetActivate(ByVal Sh As Object)
Dim plage As Range, Cellule As Range, Recherche As Range
If Sh.Name = "Devis" Then
Set plage = Sh.Range("C18:C500,D18:D500,E18:E500,F18:F500,G18:G500,H18:H500,I18:I500")
ElseIf Sh.Name = "Appro" Then
Set plage = Sh.Range("A2:C1000")
ElseIf Sh.Name = "Métrés" Then
Set plage = Sh.Range("A1:B1000")
Else
Exit Sub
End If
For Each Cellule In plage
If Not Cellule.Value = "" Then
Set Recherche = Sheets("Ouvrages").Range("D:D,G:G,L:L,M:M,N:N,O:O,P:p").Find(Cellule, lookat:=xlWhole)
If Not Recherche Is Nothing Then
Cellule.Font.FontStyle = Recherche.Font.FontStyle
Cellule.Font.Italic = Recherche.Font.Italic
Cellule.Font.Size = Recherche.Font.Size
Cellule.Font.Bold = Recherche.Font.Bold
Cellule.Font.Color = Recherche.Font.Color
Cellule.RowHeight = Recherche.RowHeight
Cellule.Interior.Color = Recherche.Interior.Color
Cellule.Font.ThemeFont = Recherche.Font.ThemeFont
Cellule.Borders(xlEdgeBottom).LineStyle = Recherche.Borders(xlEdgeBottom).LineStyle
End If
End If
Next Cellule
End Sub
 

tototiti2008

XLDnaute Barbatruc
Re : formule à vérifier

Bonjour Pierre,

Avec seulement le code et sans les données, un peu dur...

1/Pour passer ta macro de macro évènementielle en macro simple (à lancer manuellement), il faut
Insérer un module
Coller tout le code
Effacer le code de ThisWorkbook
Modifier la première ligne

Code:
Private Sub Workbook_SheetActivate(ByVal Sh As Object)
en

Code:
Sub MaMacro()
Remplacer tous les "Sh" du code en "Activesheet"

Pour le 2/ je ne sais pas
 

Discussions similaires