Création d'onglets à partir d'une liste - avec condition

Bonjour le Forum,

Je sèche sur l'ajout d'une condition à la création d'onglets dans mon fichier.

Ceci fonctionne très bien

Sub AddSheets()

    Dim xRg As Excel.Range
    Dim wSh As Excel.Worksheet
    Dim wBk As Excel.Workbook
    Set wSh = ActiveSheet
    Set wBk = ActiveWorkbook

    Application.ScreenUpdating = False

    For Each xRg In wSh.Range("A2:A400")

        With wBk
            .Sheets.Add after:=.Sheets(.Sheets.Count)
            On Error Resume Next
            ActiveSheet.Name = xRg.Value
            If Err.Number = 1004 Then
              Debug.Print xRg.Value & " already used as a sheet name"
            End If
            On Error GoTo 0
        End With

    Next xRg

    Application.ScreenUpdating = True

End Sub

Mais je ne parviens pas à mettre ma condition

If wSh.Range("C2:C400").Value Like "*Voiture*" Or "*Vélo*" Then

Je l'ai insérée comme ceci mais ça ne fonctionne pas, j'ai un incompatibilité de type

Sub AddSheets()

    Dim xRg As Excel.Range
    Dim wSh As Excel.Worksheet
    Dim wBk As Excel.Workbook
    Set wSh = ActiveSheet
    Set wBk = ActiveWorkbook

    Application.ScreenUpdating = False

    For Each xRg In wSh.Range("A2:A400")

    If wSh.Range("C2:C400").Value Like "*Voiture*" Or "*Vélo*" Then

        With wBk
            .Sheets.Add after:=.Sheets(.Sheets.Count)
            On Error Resume Next
            ActiveSheet.Name = xRg.Value
            If Err.Number = 1004 Then
              Debug.Print xRg.Value & " already used as a sheet name"
            End If
            On Error GoTo 0
        End With
        End If

    Next xRg

    Application.ScreenUpdating = True

End Sub

J'ai donc mal écrit ma condition mais je coince sur la bonne façon de l'écrire, pouvez vous m'aider?

Bonne journée à tous

Bonjour,

Sub AddSheets()

Dim xRg As Excel.Range
Dim wSh As Excel.Worksheet
Dim wBk As Excel.Workbook

    Set wSh = ActiveSheet
    Set wBk = ActiveWorkbook

    Application.ScreenUpdating = False

    For Each xRg In wSh.Range("A2:A400")
        If InStr(1, xRg.Offset(0, 2), "Voiture", vbTextCompare) > 0 Or InStr(1, xRg.Offset(0, 2), "Vélo", vbTextCompare) > 0 Then
           With wBk
                .Sheets.Add after:=.Sheets(.Sheets.Count)
                On Error Resume Next
                ActiveSheet.Name = xRg.Value
                If Err.Number = 1004 Then
                  Debug.Print xRg.Value & " already used as a sheet name"
                End If
                On Error GoTo 0
            End With
        End If
    Next xRg

    Application.ScreenUpdating = True

    Set wSh = Nothing: Set wBk = Nothing

End Sub

Merci !

Bonne journée à toi