Passez une cellule Excel en italique

Sub transform()

Dim chaine As String
Dim lig, pos, lgt As Long
'On paramètre la première ligne (ici 1)
lig = 1
'Boucle qui passe sur chaque ligne et qui s'arrete quand il n'y a plus rien dans la colonne A
Do While Not (Range("A" & lig) = "")
    
    chaine = Range("A" & lig).Value
    'Récupère la position du /
    pos = InStr(chaine, "/")
    'Calcul de la longeur du texte à mettre en italique
    lgt = (Len(chaine) - pos) + 1
    
    'On change la police depuis la position du '/'
    With Range("A" & lig).Characters(Start:=pos, Length:=lgt).Font
        .FontStyle = "Italique"
    End With
    'On passe à la ligne suivante
    lig = lig + 1
    
Loop

End Sub

Sub transform()

Dim chaine As String
Dim lig, pos, lgt As Long
'On paramètre la première ligne (ici 1)
lig = 1
'Boucle qui passe sur chaque ligne et qui s'arrete quand il n'y a plus rien dans la colonne A
Do While Not (Range("A" & lig) = "")
    
    chaine = Range("A" & lig).Value
    'Récupère la position du /
    pos = InStr(chaine, "/")
    'Calcul de la longeur du texte à mettre en italique
    lgt = (Len(chaine) - pos) + 1
    'S'il y a bien un '/'
    If Not pos = 0 Then
        'On change la police depuis la position du '/'
        With Range("A" & lig).Characters(Start:=pos, Length:=lgt).Font
            .FontStyle = "Italique"
        End With
    End If
    'On passe à la ligne suivante
    lig = lig + 1
    
Loop

End Sub

Dim Ws As Worksheet
For Each Ws In ActiveWorkbook
     ton code ici
Next Ws

Sub partieitalique()
    Dim Ws As Worksheet
    Dim debut As Integer, longueur As Integer 'définition des variables
    For Each Ws In ActiveWorkbook
        For Each cell In ActiveSheet.UsedRange 'pour toutes les cellules de la feuille
            If InStr(cell, "/") = 0 Then 'si la cellule ne contient pas de /
                GoTo suite 'alors on passe à la suivante
            End If
            debut = InStr(cell, "/") 'place du / dans la chaine de caractères contenue dans la cellule
            longueur = Len(cell) - debut + 1 'longueur de la chaine de caractères contenue dans la cellule
            With cell.Characters(Start:=debut, Length:=longueur).Font 'avec la police de cette partie de cellule
                .FontStyle = "Italique" 'et bien mettons la en italique
            End With
        Next 'cellule suivante s'il vous plait
    Next Ws
End Sub 'fin macro

Sub partieitalique()
Dim debut As Integer, longueur As Integer, j As Integer
    For j = 1 To Sheets.Count
    Sheets(j).Activate
        For Each cell In ActiveSheet.UsedRange
            If InStr(cell, "/") = 0 Then
                GoTo suite
            End If
            debut = InStr(cell, "/")
            longueur = Len(cell) - debut + 1
            With cell.Characters(Start:=debut, Length:=longueur).Font
                .FontStyle = "Italique"
            End With
suite:
        Next
    Next j
End Sub