Optimisation macro - enlever code HTML

[arthurho]

Bonjour,

J'ai réalisé (merci JNP) une macro permettant d'enlever correctement le code HTML d'une plage de données.

Je parcours un tableau html regroupant les eventuels bout de code à enlever et je boucle sur ce tableau.
Pour l'optimiser, je souhaiterais vérifier que les cellules du tableau que je vais parcourir existent bien dans le code html.

Voila ce que j'ai fait :

1) Je copie le tableau HTML où je vais supprimer les lignes qui existent dans le code avant de le parcourir.
2) Je renomme le tableau. (ERREUR)
3) Je lance un find pour chaque cellule du tableau, la selection étant une colonne de code HTML présente dans le deuxieme onglet
4) Je lance la macro pour retirer le code HTML

La macro est la suivante :

Sub FindHTMLCode2() 'SelectedRange As Range)

Dim rFound As Range, cell As Range
Dim I As Long
I = 3
    
    Sheets("HTML").Select
    Range("A2:D41").Select
    Selection.Copy
    Range("F2").Select
    ActiveSheet.Paste

    ActiveSheet.ListObjects(ListObjects.Count).Name = "UsedHTMLTable"  ========> ERREUR ICI 'Objet Requis'
    
    Sheets(2).Select
    Range(Cells(1, 7), Cells(97, 7)).Select

    With Selection
        Application.DisplayAlerts = False
        For I = 3 To Range("UsedHTMLTable[HTML]").Rows.Count
             Set rFound = .Find(What:="cells(I,7).value", After:=.Cells(1, 1), LookIn:=xlValues, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False)
             If Not rFound Is Nothing Then Range(Cells(I, 7), Cells(I, 9)).Delete
        Next I
        Application.DisplayAlerts = True
    On Error GoTo 0
    End With
End Sub
Function removeHTMLTags(onglet)
Dim Cellule As Range, I As Integer, MaString As String
Dim lastrow As Long
'Sheets("HTML").Calculate
Application.StatusBar = "Removing HTML Tags.."
lastrow = Sheets(onglet).[A65536].End(xlUp).Row
With CreateObject("vbscript.regexp")
    .Global = True
    .Pattern = "\<(?!(?:br)).*?\>"
    For Each Cellule In Selection
        MaString = Cellule.Value


        If MaString = "" And Cellule.Row > lastrow Then
            Exit For
        Else
            'MaString = Replace(MaString, "<br>", Chr(10))
            MaString = .Replace(MaString, " ")
            MaString = Replace(MaString, "<br>", Chr(10))
            For I = 1 To Range("Tableau1[HTML]").Rows.Count
                MaString = Replace(MaString, Range("Tableau1[HTML]")(I).Value, Chr(Range("Tableau1[ASCII]")(I).Value))
            Next I
        End If
        Cellule.Value = MaString
    Next Cellule
End With

End Function

Pour information, la ligne posant erreur fonctionne correctement lorsquelle est placée dans une macro sur la feuille "HTML"

Et la pièce jointe ,

Avez vous une solution ?
Cdt,

Arthur HO.