Division d'un fichier format long en onglets, 1 pour chaque personne

Bonjour,

Je dispose d'un fichier en format long où le nombre de participations est différente pour chaque personne selon le modèle ci-joint. J'aimerais créer à partir de la variable ID un onglet pour chaque participant avec les informations le concernant. D'avance un grand merci pour toute aide.

Titouane

Bonjour,

voici un fichier à tester et à adapter à tes besoins réels :

Bonjour Melch,

Je vous remercie beaucoup pour votre rapide réaction, mais je n'arrive pas à lancer la macro. Auriez-vous l'amabilité de me la renvoyer dans un document séparé?

Merci,

Titouane

La macro est la suivante :

Sub melch()
On Error Resume Next

    Set s1 = Sheets("Feuil1")
    derLig = s1.Cells(Rows.Count, 1).End(xlUp).Row

    For i = 2 To derLig
        If s1.Cells(i, 1) <> s1.Cells(i - 1, 1) Then
            Sheets.Add after:=Sheets(Sheets.Count)
            With Sheets(Sheets.Count)
                .Name = "Participant " & s1.Cells(i, 1).Value
                .Cells(1, 1) = "Participant : "
                .Cells(1, 2) = s1.Cells(i, 1)
                .Cells(2, 1) = "Choix"
                .Cells(3, 1) = s1.Cells(i, 3)
            End With
        Else
            derlig2 = Sheets(Sheets.Count).Cells(Rows.Count, 1).End(xlUp).Row + 1
            Sheets(Sheets.Count).Cells(derlig2, 1) = s1.Cells(i, 3)
        End If
    Next

    s1.Activate

End Sub

Bonjour,

pas vraiment besoin de macro ni d'une feuille par personne, autant apprendre à utiliser les fonctionnalités de base d'excel.

Il suffit d'ajouter un filtre auto et de filtrer l'ID voulu.

eric

suite...

et avec une version récente d'excel, tu peux faire 'Insertion / Tableau' et 'Insérer un segment.

L'utilisation est encore plus simple.

eric

melch a écrit :

La macro est la suivante :

Sub melch()
On Error Resume Next

    Set s1 = Sheets("Feuil1")
    derLig = s1.Cells(Rows.Count, 1).End(xlUp).Row

    For i = 2 To derLig
        If s1.Cells(i, 1) <> s1.Cells(i - 1, 1) Then
            Sheets.Add after:=Sheets(Sheets.Count)
            With Sheets(Sheets.Count)
                .Name = "Participant " & s1.Cells(i, 1).Value
                .Cells(1, 1) = "Participant : "
                .Cells(1, 2) = s1.Cells(i, 1)
                .Cells(2, 1) = "Choix"
                .Cells(3, 1) = s1.Cells(i, 3)
            End With
        Else
            derlig2 = Sheets(Sheets.Count).Cells(Rows.Count, 1).End(xlUp).Row + 1
            Sheets(Sheets.Count).Cells(derlig2, 1) = s1.Cells(i, 3)
        End If
    Next

    s1.Activate

End Sub

eriiic a écrit :

Bonjour,

pas vraiment besoin de macro ni d'une feuille par personne, autant apprendre à utiliser les fonctionnalités de base d'excel.

Il suffit d'ajouter un filtre auto et de filtrer l'ID voulu.

eric

Merci Eric, le problème est résolu maintenant!

NiamorLeahpar a écrit :

melch a écrit :

La macro est la suivante :

Sub melch()
On Error Resume Next

    Set s1 = Sheets("Feuil1")
    derLig = s1.Cells(Rows.Count, 1).End(xlUp).Row

    For i = 2 To derLig
        If s1.Cells(i, 1) <> s1.Cells(i - 1, 1) Then
            Sheets.Add after:=Sheets(Sheets.Count)
            With Sheets(Sheets.Count)
                .Name = "Participant " & s1.Cells(i, 1).Value
                .Cells(1, 1) = "Participant : "
                .Cells(1, 2) = s1.Cells(i, 1)
                .Cells(2, 1) = "Choix"
                .Cells(3, 1) = s1.Cells(i, 3)
            End With
        Else
            derlig2 = Sheets(Sheets.Count).Cells(Rows.Count, 1).End(xlUp).Row + 1
            Sheets(Sheets.Count).Cells(derlig2, 1) = s1.Cells(i, 3)
        End If
    Next

    s1.Activate

End Sub

Super Melch, merci beaucoup!