Mise en forme spécifique en tableau

[anber]

Bonsoir le Forum,

Comment mettre en forme via vba des données en tableau, avec création d'un tableau à chaque changement de valeur d'une colonne dédiée.
Ci-joint un fichier exemple avec résultat à obtenir.

Merci

 

[vgendron]

Hello
un essai avec ce code

Sub Macro1()
'
    With Sheets("base")
        fin = .Range("A" & .Rows.Count).End(xlUp).Row
        Debut = 2
        Numtab = 1
        i = 2
        While i <= fin
           
            If Cells(i, 2) <> Cells(i + 1, 2) Then
                Rows(1).Copy
                Rows(i + 1).Insert shift:=xlDown
                Rows(i + 1).Insert shift:=xlDown
               
                'Range("A" & Debut & ":G" & i).Select
                ActiveSheet.ListObjects.Add(xlSrcRange, Range("A" & Debut - 1 & ":G" & i), , xlYes).Name = "Tableau" & Numtab
                Debut = i + 3
                Numtab = Numtab + 1
                i = i + 3
                fin = fin + 2
            Else
                i = i + 1
            End If
        Wend
        .Rows(fin).Delete
    End With
End Sub

 

[anber]

Bonsoir vgendron
Merci pour ta réponse
Pour aller encore plus loin

Comment écrire le résultat dans une autre feuille ?
Ne pas avoir de filtre sur les entêtes ?
De n'avoir les entêtes que sur le 1er tableau
2 lignes de séparations entre chaque tableau

Encore Merci

 

[Staple1600]

Bonsoir le fil, le forum

@anber
Une solution où chaque tableau est sur feuille distincte est-elle envisageable?
Si oui, on peut faire cela sans macros avec un TCD.

 

[anber]

Bonsoir Staple1600

Non, pas possible.
Par contre le style en tableau était pour plus de lisibilité
Possibilité de faire la séparation des données sans le style !!!

 

[anber]

RE,
Genre

 

[Staple1600]

Re

La question que je me pose est le pourquoi de la chose?
Si tu as une base de données, l'outil idéal pour la manipuler est le TCD
(voir exemple)

 

[anber]

Re,
Non pas possible
C'est un fichier pour une machine

 

[Staple1600]

Re

Et comme cela alors?

Sub a()
Dim i As Long, rng As Range
Set rng = Sheets("base").UsedRange
For i = rng.Count To 2 Step -1
    If rng.Cells(i, 2).Value <> rng.Cells(i - 1, 2).Value Then
        rng.Cells(i, 1).Resize(2).EntireRow.Insert
    End If
Next
Sheets("base").Rows("2:3").Delete
End Sub

 

[anber]

RE,

C'est parfait
Encore une nouvelle fois Merci