Dimentionner un tableau suivant critéres

Bonjour

Je suis dans l'ignorance car je débute en vba.

Je voudrai redimensionner un tableau en fonctions du nombre de lignes du critère sélectionné.

Je vous mets une photo pour m'aider

En vous remerciant

orguyrine

capture d ecran 16

bonjour

un Tableau (avec une majuscule pour désigner "mettre sous forme de tableau" du menu Accueil) s'ajuste automatiquement

fais un filtre auto (menu Données/filtrer)

mieux : crée un segment pour faire un filtrage instinctif

tout ça en 20 secondes. Sans aucune formule.

pas de VBA !

pas de cellule contenant une variable de filtrage.

Bonjour,

Un exemple.

Cdlt.

24orguyrine.xlsm (23.83 Ko)

Bonjour,

Un exemple.

Cdlt.

orguyrine.xlsm

Le code ne fonctionne pas il me met un blocage sur la derniere ligne.Resize rng

Je vous fais parvenir le fichier

En vous remerciant

orguyrine

Re,

Essaie ainsi :

Public Sub ResizeTable()
Dim ws As Worksheet
Dim lo As ListObject
Dim lRow As Long, lCol As Long
Dim N As Long
Dim rng As Range
    Set ws = ActiveWorkbook.Worksheets("Tableau de Bord")
    Set lo = ws.ListObjects(1)
    With lo
        lCol = .ListColumns.Count: lRow = .ListRows.Count
        N = Application.CountA(.ListColumns(2).DataBodyRange)
        If lRow <> N Then
            Set rng = .HeaderRowRange.Cells(1).Resize(N + 1, lCol)
            .Resize rng
        End If
    End With
End Sub

Re,

Essaie ainsi :

Public Sub ResizeTable()
Dim ws As Worksheet
Dim lo As ListObject
Dim lRow As Long, lCol As Long
Dim N As Long
Dim rng As Range
    Set ws = ActiveWorkbook.Worksheets("Tableau de Bord")
    Set lo = ws.ListObjects(1)
    With lo
        lCol = .ListColumns.Count: lRow = .ListRows.Count
        N = Application.CountA(.ListColumns(2).DataBodyRange)
        If lRow <> N Then
            Set rng = .HeaderRowRange.Cells(1).Resize(N + 1, lCol)
            .Resize rng
        End If
    End With
End Sub

Le code fonctionne uniquement dans le sens décroissant et non croissant

Je m'explique suivant le critére j ai 5 lignes si je modifie mon critére et que j ai 15 lignes rien se passe

En vous remerciant

orguyrine

Re,

Je ne comprends rien.

Tu reformules clairement ton objectif car mettre ses données sous forme de tableau n'est pas anodin et demande reflexion à l'usage.

Cdlt.

Re,

Je ne comprends rien.

Tu reformules clairement ton objectif car mettre ses données sous forme de tableau n'est pas anodin et demande reflexion à l'usage.

Cdlt.

Si je sectionne le portugal j ai 10 piéces et le tableau se postionne bien sur la deniere ligne à la 10 piéces

Si je selectionne un autre pays j ai 20 piéces mais le tableau reste sur la 10 piéces

Pour compréhension je te remets le fichier

cordialement

orguyrine

Re,

Je n'assurerai pas de suivi pour cette procédure.

J'ai la nette impression que l'on monte une usine à gaz pour une simple mise en forme des données.

Cdlt.

Option Explicit

Public Sub FilterData()
Dim lo As ListObject, lo2 As ListObject
Dim rng As Range, rng2 As Range
Dim lCol As Long, lRow As Long
    Set lo = Worksheets("Feuil1").ListObjects(1)
    With ActiveSheet
        Set lo2 = .ListObjects(1)
        With lo2
            If Not .DataBodyRange Is Nothing Then .DataBodyRange.Delete
            lCol = .ListColumns.Count
            .Unlist
        End With
        Set rng = .Range("D8:E9")
        lo.Range.AdvancedFilter _
                Action:=xlFilterCopy, _
                criteriarange:=rng, _
                copytorange:=ActiveSheet.Range("A12:J12"), _
                unique:=False
        lRow = .Cells(.Rows.Count, 2).End(xlUp).Row - 11
        Set rng2 = .Cells(12, 1).Resize(lRow, lCol)
        Set lo2 = .ListObjects.Add(xlSrcRange, rng2, , xlYes)
        With lo2
            .Name = "TbFiltre"
            .TableStyle = "TableStyleLight1"
        End With
    End With
End Sub

Re,

Je n'assurerai pas de suivi pour cette procédure.

J'ai la nette impression que l'on monte une usine à gaz pour une simple mise en forme des données.

Cdlt.

Option Explicit

Public Sub FilterData()
Dim lo As ListObject, lo2 As ListObject
Dim rng As Range, rng2 As Range
Dim lCol As Long, lRow As Long
    Set lo = Worksheets("Feuil1").ListObjects(1)
    With ActiveSheet
        Set lo2 = .ListObjects(1)
        With lo2
            If Not .DataBodyRange Is Nothing Then .DataBodyRange.Delete
            lCol = .ListColumns.Count
            .Unlist
        End With
        Set rng = .Range("D8:E9")
        lo.Range.AdvancedFilter _
                Action:=xlFilterCopy, _
                criteriarange:=rng, _
                copytorange:=ActiveSheet.Range("A12:J12"), _
                unique:=False
        lRow = .Cells(.Rows.Count, 2).End(xlUp).Row - 11
        Set rng2 = .Cells(12, 1).Resize(lRow, lCol)
        Set lo2 = .ListObjects.Add(xlSrcRange, rng2, , xlYes)
        With lo2
            .Name = "TbFiltre"
            .TableStyle = "TableStyleLight1"
        End With
    End With
End Sub

Je vous remercie visuellement cela est plus agréable

J'essaye avec mes peu de moyens de comprendre votre code car je débute en vba

Rechercher des sujets similaires à "dimentionner tableau suivant criteres"