Créer des tableaux séparés à partir des valeurs d'un tableau

Laguamar

XLDnaute Nouveau
Salut,

J'ai un tableau avec une dizaine de colonnes. Je cherche à créer des tableaux séparés reprenant la même mise en forme avec toutes les données en fonction des valeurs de la colonne 3. Ex en col 3 ce sont des villes je souhaiterais créer des tableaux séparés par ville reprenant la mise en forme et les données du tableau de départ.

Merci par avance les amis !
 

vgendron

XLDnaute Barbatruc
si.. bien sur.. tu peux aussi faire comme ca....
sans déconner... tu espères quand meme pas qu'on va t'inventer un fichier avec le peu d'infos que tu fournis...
 

Laguamar

XLDnaute Nouveau
Désolé j'essaie juste d'être curieux et j'ai un niveau avancé dans Excel mais je ne suis pas dans le développement. Si le problème vient de ma demande initiale, je la croyais explicite et je te prie de m'en excuser. Es-tu toujours OK pour m'aider si je te fournis un fichier Excel en ex ? Encore désolé ! Si tu vois des horaires un peu bizarres t'inquiète je suis au Canada ! Merci pour ton temps A+
 

Staple1600

XLDnaute Barbatruc
Bonsoir le fil, le forum

@Laguamar
Quelque soit le fuseau horaire
Qu'il vente ou qu'il pleuve
Les jours impairs ou pairs
Les nuits avec ou sans lune
Ce petit conseil (des plus judicieux) issu de la charte du forum reste valable ;)
5 – La possibilité de joindre des fichiers est donnée sur ce forum.
Ne pas hésiter à utiliser cette fonction, tout en veillant que les données soient bidons et donc qu’aucune donnée confidentielle, nominative ne soit dans le fichier.
 

Laguamar

XLDnaute Nouveau
Voici mon fichier. Ce que je cherche et que je n'ai pas trouvé dans les fonctions d'Excel, c'est de pouvoir à partir de ce tableau créer des copies séparées par ville (col 3). Autrement dit je devrais avoir ici 5 classeurs séparés générés avec leurs propres données (2 lignes pour Bordeaux et 3 pour Nice par ex). Merci encore !
 

Fichiers joints

vgendron

XLDnaute Barbatruc
Hello
et bah voila.. avec un fichier en exemple. c'est quand meme plus simple

Voir proposition en PJ avec quelques limitations:
- les tableaux sont créés dans un nouvel onglet du nom de la ville
- pour l'instant. la mise en forme n'est pas recopiée..
est ce que la mise en forme de départ (feuille 1) est figée? ou est ce que je peux te proposer autre chose à base de table excel..
et si tu cliques plusieurs fois sur le bouton. bug. car pas de controle pour voir si les onglets existent déjà.
 

Fichiers joints

vgendron

XLDnaute Barbatruc
Code modifié pour créer des "Tables" excel

VB:
Sub CreerTableaux()
Dim Unique As New Collection 'contiendra la liste des villes sans doublon
Dim tablo() As Variant 'contient tout le tableau de la feuille 1

With Sheets("Feuil1")
    fin = .UsedRange.Rows.Count
    tablo = .Range("A2:G" & fin).Value
    entete = .Range("A1:G1").Value
   
    On Error Resume Next
    For i = LBound(tablo, 1) To UBound(tablo, 1)
        Unique.Add tablo(i, 3), tablo(i, 3)
    Next i
End With

For Each ville In Unique
    Sheets.Add
    With ActiveSheet
        .Name = ville
        .Range("A1:G1") = entete
        k = 2
        For i = LBound(tablo, 1) + 1 To UBound(tablo, 1)
            If tablo(i, 3) = ville Then
                For j = LBound(tablo, 2) To UBound(tablo, 2)
                    .Cells(k, j) = tablo(i, j)
                Next j
                k = k + 1
            End If
        Next i
       
        .ListObjects.Add(xlSrcRange, Range("$A$1:$G$" & k - 1), , xlYes).Name = "Tab" & ville
        .ListObjects("Tab" & ville).TableStyle = "TableStyleMedium9"
       
    End With
Next ville
End Sub
 

Laguamar

XLDnaute Nouveau
Salut, merci pour ton temps ! En fait ce sont des classeurs séparés que je souhaite obtenir, pas des onglets. Ils doivent reprendre la mise en forme du tableau et elle peut ne pas être figée. Le tableau pourrait comporter pls de colonnes mais les références seront toujours en col 3. J'ai vu également que l'onglet Nice par ex n'avait que 2 lignes alors qu'il devrait en avoir 3. Merci pour ton aide !
 

Staple1600

XLDnaute Barbatruc
Bonsoir le fil, le forum

@Laguamar
Il y avait un second conseil (entre autres) tout aussi judicieux dans la charte du forum
1 – Un outil de recherche sur le forum permet de voir si la question a déjà été posée. Ne pas hésiter à l’utiliser. Lien vers le moteur de recherche
La preuve ;)
https://www.excel-downloads.com/threads/ventiler-une-base-en-feuilles-et-onglets-vba.20021981/#post-20163161

NB: Je te laisse faire les adaptations nécessaires de mon code pour coller à ta problématique.

EDITION: Bonsoir vgendron ;)
 
Dernière édition:

Laguamar

XLDnaute Nouveau
Oui j'avais tapé ma question dans le moteur de recherche mais je n'avais pas trouvé l'info voulue. Je ne maîtrise pas le langage de programmation mais je vais essayer de regarder et comprendre ton code. Merci pour le temps passé à m'aider les mecs!
 

vgendron

XLDnaute Barbatruc
Salut
Hello Staple1600

correction pour la ligne "Nice" manquante. c'était juste un problème d'indice
VB:
Sub CreerTableaux()
Dim Unique As New Collection 'contiendra la liste des villes sans doublon
Dim tablo() As Variant 'contient tout le tableau de la feuille 1

With Sheets("Feuil1")
    fin = .UsedRange.Rows.Count
    tablo = .Range("A2:G" & fin).Value
    entete = .Range("A1:G1").Value
   
    On Error Resume Next
    For i = LBound(tablo, 1) To UBound(tablo, 1)
        Unique.Add tablo(i, 3), tablo(i, 3)
    Next i
End With

For Each ville In Unique
    Sheets.Add
   
    With ActiveSheet
        ActiveWindow.DisplayGridlines = False
        .Name = ville
        .Range("A1:G1") = entete
        k = 2
        For i = LBound(tablo, 1) To UBound(tablo, 1)
            If tablo(i, 3) = ville Then
                For j = LBound(tablo, 2) To UBound(tablo, 2)
                    .Cells(k, j) = tablo(i, j)
                Next j
                k = k + 1
            End If
        Next i
       
        .ListObjects.Add(xlSrcRange, Range("$A$1:$G$" & k - 1), , xlYes).Name = "Tab" & ville
        .ListObjects("Tab" & ville).TableStyle = "TableStyleMedium9"
       
    End With
Next ville
End Sub
 

Laguamar

XLDnaute Nouveau
Salut
Hello Staple1600

correction pour la ligne "Nice" manquante. c'était juste un problème d'indice
VB:
Sub CreerTableaux()
Dim Unique As New Collection 'contiendra la liste des villes sans doublon
Dim tablo() As Variant 'contient tout le tableau de la feuille 1

With Sheets("Feuil1")
    fin = .UsedRange.Rows.Count
    tablo = .Range("A2:G" & fin).Value
    entete = .Range("A1:G1").Value
  
    On Error Resume Next
    For i = LBound(tablo, 1) To UBound(tablo, 1)
        Unique.Add tablo(i, 3), tablo(i, 3)
    Next i
End With

For Each ville In Unique
    Sheets.Add
  
    With ActiveSheet
        ActiveWindow.DisplayGridlines = False
        .Name = ville
        .Range("A1:G1") = entete
        k = 2
        For i = LBound(tablo, 1) To UBound(tablo, 1)
            If tablo(i, 3) = ville Then
                For j = LBound(tablo, 2) To UBound(tablo, 2)
                    .Cells(k, j) = tablo(i, j)
                Next j
                k = k + 1
            End If
        Next i
      
        .ListObjects.Add(xlSrcRange, Range("$A$1:$G$" & k - 1), , xlYes).Name = "Tab" & ville
        .ListObjects("Tab" & ville).TableStyle = "TableStyleMedium9"
      
    End With
Next ville
End Sub
Salut
Hello Staple1600

correction pour la ligne "Nice" manquante. c'était juste un problème d'indice
VB:
Sub CreerTableaux()
Dim Unique As New Collection 'contiendra la liste des villes sans doublon
Dim tablo() As Variant 'contient tout le tableau de la feuille 1

With Sheets("Feuil1")
    fin = .UsedRange.Rows.Count
    tablo = .Range("A2:G" & fin).Value
    entete = .Range("A1:G1").Value
  
    On Error Resume Next
    For i = LBound(tablo, 1) To UBound(tablo, 1)
        Unique.Add tablo(i, 3), tablo(i, 3)
    Next i
End With

For Each ville In Unique
    Sheets.Add
  
    With ActiveSheet
        ActiveWindow.DisplayGridlines = False
        .Name = ville
        .Range("A1:G1") = entete
        k = 2
        For i = LBound(tablo, 1) To UBound(tablo, 1)
            If tablo(i, 3) = ville Then
                For j = LBound(tablo, 2) To UBound(tablo, 2)
                    .Cells(k, j) = tablo(i, j)
                Next j
                k = k + 1
            End If
        Next i
      
        .ListObjects.Add(xlSrcRange, Range("$A$1:$G$" & k - 1), , xlYes).Name = "Tab" & ville
        .ListObjects("Tab" & ville).TableStyle = "TableStyleMedium9"
      
    End With
Next ville
End Sub

Merci beaucoup pour la correction t'es un champion je vais partir de là !!!
 

vgendron

XLDnaute Barbatruc
Salut Gosselien

Juste parce que j'ai découvert la collection il n'y a pas longtemps et que pour l'utilisation d'un dictionnaire. je galère toujours.. ne serait ce que pour retrouver la syntaxe juste pour déclarer le dico.. :-D. je sais. c'est pas bien. ca s'appelle de la flemme :-D
 

gosselien

XLDnaute Barbatruc
Salut Gosselien
Juste parce que j'ai découvert la collection il n'y a pas longtemps et que pour l'utilisation d'un dictionnaire. je galère toujours.. ne serait ce que pour retrouver la syntaxe juste pour déclarer le dico.. :-D. je sais. c'est pas bien. ca s'appelle de la flemme :-D
Hello :)
Hooo , loin de moi critiquer une flemme en tout cas :), moi le roi de la procrastination...
Mon cerveau mononeurone a beaucoup de mal avec les dico, mais j'ai lu sur le site de JB que les dico sont + rapide sur un grand nombre de données et que la collection serait à réserver au Mac qui n'autorise pas les dictionnaires (S ù£¨*%µç06 d'excel sur mac , insuportable ! :D )
P.
 

vgendron

XLDnaute Barbatruc

Créez un compte ou connectez vous pour répondre

Vous devez être membre afin de pouvoir répondre ici

Créer un compte

Créez un compte Excel Downloads. C'est simple!

Connexion

Vous avez déjà un compte? Connectez vous ici.

Haut Bas