Onglets à partir de colonne

micgca · 14 Septembre 2018

Bonjour à tous,
j'ai une feuille avec des données comme
A1 = nr
A2 = Nom
A3= Prénom
ensuite on passe à
A8 = age
A9 = ville

et ma question est comment créer un onglet avec les données des colonnes B, un onglet avec les données de la colonne C etc de manière à avoir autant d'onglet que de colonnes.
Les noms d'onglet pourraient être nommés automatiquement avec le champ nr

Merci par avance pour le code.

PS : j'avais le code ci-dessous mais cela fonction lorsque les données sont en ligne et non en colonne

Sub test()

Dim i%, k%

Application.ScreenUpdating = False

With Sheets("Table")

'suppression des onglets existant deja

For k = Sheets.Count To 1 Step -1

If Left(Sheets(k).Name, 7) = "Dossier" Then

Application.DisplayAlerts = False

Sheets(k).Delete

Application.DisplayAlerts = True

End If

Next k

'boucle sur le nombre de dossier

For i = 2 To .Range("A65536").End(xlUp).Row

'création de l'onglet à partir de l'onglet vierge Formulaire

Sheets("Formulaire").Copy After:=Sheets(Sheets.Count)

ActiveSheet.Name = "Dossier_" & i - 1

.Range(.Cells(i, 1), .Cells(i, 9)).Copy

Sheets("Dossier_" & i - 1).Range("B2").PasteSpecial Paste:=xlValues, Transpose:=True

Next i

End With

Application.ScreenUpdating = True

End Sub

vgendron · 14 Septembre 2018

Hello
Pour parcourir les données selon les colonnes
LastCol= Cells(1, Columns.Count).End(xlToLeft).Column 'dernière colonne de la ligne 1
for i= 2 to LastCol
....

micgca · 14 Septembre 2018

je suis perdu dans mon code, je ne sais plus où modifier les lignes,
désolé je n'y arrive pas

micgca · 14 Septembre 2018

Bon,
pour être plus explicite, je joins un fichier.
On a une table Suivi que regroupe toutes les données.
On a un modèle de formulaire.

Ce que je cherche à faire : une macro qui va générer un nouvel onglet ou feuille qui aura comme nom le nr (ligne 2 de suivi)
et chaque nouvelle feuille reprendra les données par colonne de la feuille suivi.

Je galère un peu, même beaucoup.
Merci par avance.

vgendron · 14 Septembre 2018

Ca ne m'étonne pas que tu n'y arrives pas. ton code initial ne semble pas du tout correspondre à ton fichier..

essai en PJ

micgca · 14 Septembre 2018

Et bien oups pour moi,
et je n'aurai qu'un mot pour toi : PARFAIT.

un grand merci

micgca · 14 Septembre 2018

juste un petit truc, si on ajoute des données dans la feuille suivi, bug ou pas si on clic sur le bouton ?

vgendron · 14 Septembre 2018

Bug.. car aucun controle pour savoir si la feuille existe déjà.. (si tu poses la question. c'est que tu as sans doute déjà la réponse... :-D

il faut donc ajouter un test

vgendron · 14 Septembre 2018

avec le test

VB:

Sub CréerOnglets()
Application.ScreenUpdating = False
Dim tablo() As Variant
With Sheets("Suivi")
    LastLine = .Range("A" & .Rows.Count).End(xlUp).Row 'on cherche la dernière ligne de la feuille
    LastCol = .UsedRange.Columns.Count 'on cherche la dernière colonne de la feuille
   
    tablo = .Range("A2").Resize(LastLine - 1, LastCol).Value 'on met toutes les data dans un tableau VBA
End With

For j = LBound(tablo, 2) + 1 To UBound(tablo, 2) 'pour chaque colonne
    If Not (FeuilleExiste("nr" & tablo(1, j))) Then
        Sheets("Formulaire").Copy after:=Sheets(Sheets.Count) 'on copie la feuille Formulaire
        Sheets("Formulaire (2)").Name = "nr" & tablo(1, j) 'qu'on renomme
        With Sheets("nr" & tablo(1, j)) 'dans cette nouvelle feuille
            For i = LBound(tablo, 1) To UBound(tablo, 1)
                .Range("B7").Offset(i - 1, 0) = tablo(i, j) 'on colle toutes les lignes
            Next i
        End With
    End If
Next j
Application.ScreenUpdating = True
End Sub


Function FeuilleExiste(NomFeuille As Variant) As Boolean
With ActiveWorkbook
    FeuilleExiste = False
    For Each ws In .Sheets
        If ws.Name = NomFeuille Then
            FeuilleExiste = True
            Exit For
        End If
    Next ws
End With
End Function

micgca · 14 Septembre 2018

c'est ok, merci,
dernière chose, si je transpose tout cela dans un autre fichier, je ne sais pas pourquoi mais ça bug sur la ligne
With Sheets("nr" & tablo(1, j)) 'dans cette nouvelle feuille

micgca · 14 Septembre 2018

non c'est bon c'est encore moi qui me trompait,
dernière chose, si je ne veux pas toutes les lignes mais les 12 premières uniquement ?

et si je veux les 12 premières ET les lignes 17 et 19 ?

juste le code après c'est promis je me débrouille

micgca · 29 Octobre 2018

vgendron à dit:

avec le test

VB:

Sub CréerOnglets()
Application.ScreenUpdating = False
Dim tablo() As Variant
With Sheets("Suivi")
    LastLine = .Range("A" & .Rows.Count).End(xlUp).Row 'on cherche la dernière ligne de la feuille
    LastCol = .UsedRange.Columns.Count 'on cherche la dernière colonne de la feuille
  
    tablo = .Range("A2").Resize(LastLine - 1, LastCol).Value 'on met toutes les data dans un tableau VBA
End With

For j = LBound(tablo, 2) + 1 To UBound(tablo, 2) 'pour chaque colonne
    If Not (FeuilleExiste("nr" & tablo(1, j))) Then
        Sheets("Formulaire").Copy after:=Sheets(Sheets.Count) 'on copie la feuille Formulaire
        Sheets("Formulaire (2)").Name = "nr" & tablo(1, j) 'qu'on renomme
        With Sheets("nr" & tablo(1, j)) 'dans cette nouvelle feuille
            For i = LBound(tablo, 1) To UBound(tablo, 1)
                .Range("B7").Offset(i - 1, 0) = tablo(i, j) 'on colle toutes les lignes
            Next i
        End With
    End If
Next j
Application.ScreenUpdating = True
End Sub


Function FeuilleExiste(NomFeuille As Variant) As Boolean
With ActiveWorkbook
    FeuilleExiste = False
    For Each ws In .Sheets
        If ws.Name = NomFeuille Then
            FeuilleExiste = True
            Exit For
        End If
    Next ws
End With
End Function

vgendron à dit:

avec le test

VB:

Sub CréerOnglets()
Application.ScreenUpdating = False
Dim tablo() As Variant
With Sheets("Suivi")
    LastLine = .Range("A" & .Rows.Count).End(xlUp).Row 'on cherche la dernière ligne de la feuille
    LastCol = .UsedRange.Columns.Count 'on cherche la dernière colonne de la feuille
  
    tablo = .Range("A2").Resize(LastLine - 1, LastCol).Value 'on met toutes les data dans un tableau VBA
End With

For j = LBound(tablo, 2) + 1 To UBound(tablo, 2) 'pour chaque colonne
    If Not (FeuilleExiste("nr" & tablo(1, j))) Then
        Sheets("Formulaire").Copy after:=Sheets(Sheets.Count) 'on copie la feuille Formulaire
        Sheets("Formulaire (2)").Name = "nr" & tablo(1, j) 'qu'on renomme
        With Sheets("nr" & tablo(1, j)) 'dans cette nouvelle feuille
            For i = LBound(tablo, 1) To UBound(tablo, 1)
                .Range("B7").Offset(i - 1, 0) = tablo(i, j) 'on colle toutes les lignes
            Next i
        End With
    End If
Next j
Application.ScreenUpdating = True
End Sub


Function FeuilleExiste(NomFeuille As Variant) As Boolean
With ActiveWorkbook
    FeuilleExiste = False
    For Each ws In .Sheets
        If ws.Name = NomFeuille Then
            FeuilleExiste = True
            Exit For
        End If
    Next ws
End With
End Function

vgendron à dit:

avec le test

VB:

Sub CréerOnglets()
Application.ScreenUpdating = False
Dim tablo() As Variant
With Sheets("Suivi")
    LastLine = .Range("A" & .Rows.Count).End(xlUp).Row 'on cherche la dernière ligne de la feuille
    LastCol = .UsedRange.Columns.Count 'on cherche la dernière colonne de la feuille
  
    tablo = .Range("A2").Resize(LastLine - 1, LastCol).Value 'on met toutes les data dans un tableau VBA
End With

For j = LBound(tablo, 2) + 1 To UBound(tablo, 2) 'pour chaque colonne
    If Not (FeuilleExiste("nr" & tablo(1, j))) Then
        Sheets("Formulaire").Copy after:=Sheets(Sheets.Count) 'on copie la feuille Formulaire
        Sheets("Formulaire (2)").Name = "nr" & tablo(1, j) 'qu'on renomme
        With Sheets("nr" & tablo(1, j)) 'dans cette nouvelle feuille
            For i = LBound(tablo, 1) To UBound(tablo, 1)
                .Range("B7").Offset(i - 1, 0) = tablo(i, j) 'on colle toutes les lignes
            Next i
        End With
    End If
Next j
Application.ScreenUpdating = True
End Sub


Function FeuilleExiste(NomFeuille As Variant) As Boolean
With ActiveWorkbook
    FeuilleExiste = False
    For Each ws In .Sheets
        If ws.Name = NomFeuille Then
            FeuilleExiste = True
            Exit For
        End If
    Next ws
End With
End Function

micgca · 29 Octobre 2018

Bonjour à tous,
après avoir bien travailler sur le fichier, tout fonctionne bien, je recherche un code pour mettre à jour les onglets créés si on modifie le tableau général.
Merci par avance.

Onglets à partir de colonne

micgca

XLDnaute Junior

vgendron

XLDnaute Barbatruc

micgca

XLDnaute Junior

micgca

XLDnaute Junior

Pièces jointes

vgendron

XLDnaute Barbatruc

Pièces jointes

micgca

XLDnaute Junior

micgca

XLDnaute Junior

vgendron

XLDnaute Barbatruc

vgendron

XLDnaute Barbatruc

micgca

XLDnaute Junior

micgca

XLDnaute Junior

micgca

XLDnaute Junior

micgca

XLDnaute Junior

Discussions similaires

Onglets à partir de colonne

XLDnaute Junior

XLDnaute Barbatruc

XLDnaute Junior

XLDnaute Junior

Pièces jointes

XLDnaute Barbatruc

Pièces jointes

XLDnaute Junior

XLDnaute Junior

XLDnaute Barbatruc

XLDnaute Barbatruc

XLDnaute Junior

XLDnaute Junior

XLDnaute Junior

XLDnaute Junior

Discussions similaires

Privacy & Transparency

Privacy & Transparency