Simplification de code vba Excel
Bonjour à tous,
J'ai mis en place les codes suivants que je recopie dans 250 feuilles, c'est un travail fastidieux. Je souhaiterai mettre en place un module avec ces codes et ainsi rendre moi lourde la saisie dans toutes les feuilles. Comment puis-je procéder ? Pouvez-vous m'apporter votre aide s'il vous plait ? J'ai bien essayé de copier ces codes dans un module, mais cela ne fonctionne pas. Je dois certainement oublier de faire quelque chose mais je n'arrive pas à trouver.
Je vous en remercie par avance
Code:
1
2
3
4
5
6
7
8
9
|
Sub affiche()
Dim FNew As Worksheet, Wb As Workbook
Set Wb = ThisWorkbook
For Each FNew In Wb.Worksheets
FNew.Visible = xlSheetVisible
Next FNew
Set FNew = Nothing: Set Wb = Nothing
End Sub |
Code:
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
|
'En cliquant dans une cellule de la colonne A, si pas de saisie de nom dans la colonne C alors message d'avertissement. Sinon, ouverture d'un fichier "FL" avec le numéro de la ligne.
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
'on error GoTo fin
If Not Intersect([A12:A39], Target) Is Nothing Then
Cancel = True
If Target(, 2).Value = "" Then MsgBox "Merci de saisir votre NOM dans la cellule" & " " & Target(, 2).Address(0, 0): Exit Sub
Dim FNew As Worksheet, Wb As Workbook, Sh As Worksheet
Dim Cible As String
Dim NumLig As Variant
NumLig = ActiveSheet.Range("D5")
Cible = ("FL" & NumLig)
Set Wb = ThisWorkbook
On Error Resume Next
Set FNew = Wb.Worksheets(Cible)
On Error GoTo Fin
If Not FNew Is Nothing Then
FNew.Activate
FNew.Visible = True
Else
GoTo Fin
End If
'on masque les feuilles inutiles
For Each Sh In Wb.Worksheets
If FNew.name <> Cible Then
If FNew.name <> ("L" & NumLig) Then
FNew.Visible = xlSheetVeryHidden
End If
End If
Next Sh
FNew.Cells((Target.Value - 1) * 41 + 2, 3).Select
'Application.GoTo reference:=
End If
FNew.Rows("1:1185").Hidden = True
FNew.Range(FNew.Cells((Target.Value - 1) * 41 + 2, 3), FNew.Cells((Target.Value - 1) * 41 + 1 + 38, 3)).EntireRow.Hidden = False
FNew.Cells((Target.Value - 1) * 41 + 2, 3).Select
Application.Goto FNew.Cells((Target.Value - 1) * 41 + 2, 3), True
Fin:
Set FNew = Nothing: Set Wb = Nothing: Set Sh = Nothing
End Sub |
Code:
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
|
' Si dans la colonne C on tape autre chose que du numérique, message d'avertissement, retour en arrière et effacement de la saisie dans la cellule.
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Range("C12:C39"), Target) Is Nothing And Target.Count = 1 Then
If Not IsNumeric(Target) Then
MsgBox "Merci de saisir un montant !!!"
With Application
.EnableEvents = False
.Undo
.EnableEvents = True
End With
End If
End If
End Sub |
