Onglets à partir de colonne

[micgca]

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]

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]

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

 

[micgca]

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]

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]

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

un grand merci

 

[micgca]

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

 

[vgendron]

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]

avec le test

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]

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]

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]

avec le test

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

avec le test

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

avec le test

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]

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.