Appliquer un code VBA a toute les feuilles

Bonsoir a tous,Sur un classeur comportant plusieurs feuille identique je viens renseigner la feuille active par un USERFORM comportant plusieurs TextBox.

Mon problème est que pour cela le code a été placé dans la feuil1 , j'active le Userform quand je me positionne sur une cellule de cette feuil1.

Le Userform s'ouvre , je renseigne les Texbox et après validation celui ci inject ma saisie dans la feuil1.

Y a t'i un moyen d’appliquer le code ce trouvant dans la feuil1 au autre feuil ou doit on le dupliquer sur toutes les feuilles.

Ci dessous mon code pressent dans la feuil1.

Private Sub Worksheet_Calculate()

On Error Resume Next 'au cas ou nom de feuille existe déjà ou invalide

Me.Name = Range("B7")

End Sub

Private Sub Worksheet_Change(ByVal Target As Range)

If Target.Address(0, 0) = "B7" And Target.Text <> vbNullString Then ActiveSheet.Name = Target.Text

End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

'''''''''''''''Blocage de l'ouverture du masque de saisie'''''''''''''''''

'''Declenchement du masque de saisie a l'activation d'une cellule comprise dans une plage donnée

If Not Application.Intersect(Target, Range("B10:P47")) Is Nothing Then 'sur la plage prevue

If ActiveCell.Value <> "" Then 'si la cellule n'est pas vide alors

With ActiveCell ' sur la cellule active

'ActiveCell.FormulaR1C1 = "" & Chr(10) & "" & Chr(10) & "" & Chr(10) & ""

With Selection.Font 'couleur de police noir

.ThemeColor = xlThemeColorLight1

.TintAndShade = 0

Masquedesaisie.Show 'ouverture du masque de saisie

End With

End With

End If

End If

End Sub

Merci de votre aide

Bonsoir,

Il suffit d'insérer le code dans ThisWorkBook avec les procédures événementielles suivantes :

Private Sub Workbook_SheetCalculate(ByVal Sh As Object)
    On Error Resume Next 'au cas ou nom de feuille existe déjà ou invalide
    Sh.Name = Range("B7")
End Sub

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
    If Target.Address(0, 0) = "B7" And Target.Text <> vbNullString Then Sh.Name = Target.Text
End Sub

Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
    '''''''''''''''Blocage de l'ouverture du masque de saisie'''''''''''''''''

    '''Declenchement du masque de saisie a l'activation d'une cellule comprise dans une plage donnée
    If Not Application.Intersect(Target, Sh.Range("B10:P47")) Is Nothing Then 'sur la plage prevue
        If ActiveCell.Value <> "" Then 'si la cellule n'est pas vide alors
            With ActiveCell ' sur la cellule active
            'ActiveCell.FormulaR1C1 = "" & Chr(10) & "" & Chr(10) & "" & Chr(10) & ""
                With Selection.Font 'couleur de police noir
                    .ThemeColor = xlThemeColorLight1
                    .TintAndShade = 0
                    Masquedesaisie.Show 'ouverture du masque de saisie
                End With
            End With
        End If
    End If

End Sub

bonsoir THEV,

Un grand merci pour ton aide ça fonctionne très bien.

Encore Merci

Jimmy