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