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.
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.
VB:
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