XL 2019 ListObjects -- Erreur 1004

[Kushi]

Bonjour à tous !

J'espère que vous allez tous très bien (que si vous avez des vacances, ça se passe bien également !)
Pour ma part je vais bien 😁

Je viens vers vous aujourd'hui pour une question à propos de la création d'un ListObjects qui ne fonctionne pas sur mon code... J'obtiens l'erreur ci-dessous :

impossible de m'en défaire... pouvez-vous m'aider svp ?
Mon code en question ainsi que l'excel en pj.

Private Sub CommandButton2_Click()

Range("M:N").Delete

ActiveWorkbook.Sheets("VISSERIE").ListObjects.Add(xlSrcRange, Range("$M$1:$M$16"), , xlYes).Name = _
"Critères"
Range("M1").Value = "Ligne de Nomenclature"
Range("M2").Value = "*VIS*"
Range("M3").Value = "*ECROU*"
Range("M4").Value = "*HUCKLOK*"
Range("M5").Value = "*SCREW*"
Range("M6").Value = "*NUT*"
Range("M7").Value = "*WASHER*"
Range("M8").Value = "*RONDELLE*"
Range("M9").Value = "*BOM*"
Range("M10").Value = "*SIMAF*"
Range("M11").Value = "*RESSORT*"
Range("M12").Value = "*RIV.*"
Range("M13").Value = "*NORD-LOCK*"
Range("M14").Value = "*SCR.*"
Range("M15").Value = "*ECR.*"
Range("M16").Value = "*GOUPILLE*"

Sheets.Add.Name = "RESULTAT"

With Range("Nomenclature_1").ListObject
    Application.CutCopyMode = False
    .Range.AdvancedFilter Action:=xlFilterCopy, _
        CriteriaRange:=Range("Critères[[#All],[Ligne de Nomenclature]]"), CopyToRange:=Worksheets("RESULTAT").Range("A1"), _
        Unique:=False
End With
    
With Worksheets("RESULTAT")
    Dim nbligne As Integer
    nbligne = WorksheetFunction.CountA(.Columns(3)) - 1

    .Range("H1").Select
    ActiveCell.FormulaR1C1 = "Nombre d'objets différents"
    Worksheets("RESULTAT").Range("I1").Formula = "=SUMPRODUCT(1/COUNTIF(RESULTAT!C2:C" & nbligne & ",RESULTAT!C2:C" & nbligne & "))"

    Set mondico = CreateObject("Scripting.Dictionary")
    For Each c In .Range("C2:C" & nbligne + 1)
        mondico(c.Value) = mondico(c.Value) + 1
    Next c
    .[E2].Resize(mondico.Count, 1) = Application.Transpose(mondico.keys)
    .[F2].Resize(mondico.Count, 1) = Application.Transpose(mondico.items)
    
    .Range("E1").FormulaR1C1 = "Lignes triées"
    .Range("F1").FormulaR1C1 = "Nbr"

    .Columns("A:XFD").AutoFit
    
End With

    Dim Table1 As ListObject
        i = 0
    Do While Range("F" & i + 1).Value <> ""
        i = i + 1
    Loop
    Set Table1 = Sheets("RESULTAT").ListObjects.Add(xlSrcRange, Range("E1:F" & i + 1), , xlYes)

End Sub

 

[job75]

Bonjour Kushi,

Remplacer :

    Set Table1 = Sheets("RESULTAT").ListObjects.Add(xlSrcRange, Range("E1:F" & i + 1), , xlYes)

par :

    Set Table1 = Sheets("RESULTAT").ListObjects.Add(xlSrcRange, Sheets("RESULTAT").Range("E1:F" & i + 1), , xlYes)

A+

 

[Kushi]

Bonjour Kushi,

Remplacer :

    Set Table1 = Sheets("RESULTAT").ListObjects.Add(xlSrcRange, Range("E1:F" & i + 1), , xlYes)

par :

    Set Table1 = Sheets("RESULTAT").ListObjects.Add(xlSrcRange, Sheets("RESULTAT").Range("E1:F" & i + 1), , xlYes)

A+

Bonjour Job75,

Merci beaucoup !!

 

[patricktoulon]

Bonjour juste en passant
on accède à la plage qu'une fois
on transforme en listobject après

Sub test()
    With ActiveWorkbook.Sheets("VISSERIE")
        a = Array("Ligne de Nomenclature", "*VIS*", "*ECROU*", "*HUCKLOK*", "*SCREW*", "*NUT*", "*WASHER*", "*RONDELLE*", "*BOM*", _
                  "*SIMAF*", "*RESSORT*", "*RIV.*", "*NORD-LOCK*", "*SCR.*", "*ECR.*", "*GOUPILLE*")
        
        .[m1].Resize(UBound(a) + 1) = Application.Transpose(a)

        With .ListObjects.Add(xlSrcRange, .[m1].Resize(UBound(a) + 1), , xlYes)
            .Name = "Critères"
            .TableStyle = "TableStyleLight9"
            ' autres properties  ou fonction ici
        End With
    End With

End Sub