Répartir les valeurs des cellules de la feuille 1 dans des tableaux

Bonjour
J'ai une feuille 1 de données dans plusieurs cellules du style : NOM, Prénom, chorale, date, ..... Et je voudrais reporter les valeurs de toutes les cellules de la ligne 1 dans un tableau présenté format A4, sur la feuille N+1, les valeurs des cellules de la ligne 2, sur une feuille N+ 2, etc .
Mon classeur aurait au final autant de feuilles que de lignes sur la première feuille.
Suis-je assez clair
D'avance un grand merci

Hello,

Pas très compliqué avec la bonne méthode. Un peu de VBA et de bon sens feront le taff

1) Avoir un onglet "Base de données" propre, ce qui a l'air d'être le cas

2) Créer un onglet modèle qui correspond à l'onglet qui va se dupliquer autant de fois qu'il y a de ligne dans le tableau

3) Créer une macro VBA qui va dupliquer l'onglet et prendre les données de chaque ligne de ton tableau

Envoie un fichier représentatif avec deux lignes de tes données et un onglet modèle avec ce que tu souhaites obtenir.

@+

Merci de ton retour.
Voici l'exemple de fichier.
A++

Hello,

Voici une première proposition

@+

Edit :
Voici le code pour les intéressés qui ne veulent pas ouvrir le fichier. C'est le code de base que j'utilise et que j'adapte dès que j'ai ce cas là

Sub Creer_Onglets_Concerts()

    Dim wsListe As Worksheet
    Dim wsModele As Worksheet
    Dim wsNew As Worksheet
    Dim lastRow As Long
    Dim i As Long
    Dim nomFeuille As String

    Set wsListe = Worksheets("Liste Concerts")
    Set wsModele = Worksheets("Modèle")

    ' Dernière ligne de données
    lastRow = wsListe.Cells(wsListe.Rows.Count, "A").End(xlUp).Row

    Application.ScreenUpdating = False

    ' Boucle sur chaque concert
    For i = 3 To lastRow

        ' Nom de l’onglet (ex : Concert_1)
        nomFeuille = "Concert_" & wsListe.Cells(i, "A").Value

        ' Supprimer si existe déjà
        On Error Resume Next
        Application.DisplayAlerts = False
        Worksheets(nomFeuille).Delete
        Application.DisplayAlerts = True
        On Error GoTo 0

        ' Copier le modèle
        wsModele.Copy After:=Worksheets(Worksheets.Count)
        Set wsNew = ActiveSheet
        wsNew.Name = nomFeuille

        ' Remplissage des données (colonnes A, B, C etc.)
        wsNew.Range("B3").Value = wsListe.Cells(i, "A").Value   ' N°
        wsNew.Range("A6").Value = wsListe.Cells(i, "D").Value   ' Date
        wsNew.Range("B6").Value = wsListe.Cells(i, "B").Value   ' Commune
        wsNew.Range("C6").Value = wsListe.Cells(i, "C").Value   ' Salle

        wsNew.Range("A11").Value = wsListe.Cells(i, "E").Value   ' Organisateur
        wsNew.Range("B11").Value = wsListe.Cells(i, "F").Value   ' Téléphone
        wsNew.Range("C11").Value = wsListe.Cells(i, "G").Value   ' Mail

    Next i

    Application.ScreenUpdating = True

    MsgBox "Onglets créés avec succès !", vbInformation

End Sub

Bonjour à tous,

Une autre proposition ci-joint.

Code correspondant ci-après

Option Explicit

' contient les infos d'une ligne
Public Type DataRecord
  Num As Long
  Ddate As Date
  Comm As String
  Salle As String
  Orga As String
  Tel As String
  Email As String
End Type

Public Sub CreerNouvellesFeuilles()
  ' feuille a copier (modele)
  Dim templateSht As Worksheet: Set templateSht = ThisWorkbook.Worksheets("concert 1")

  ' tableau de la liste de concerts
  Dim tData As Variant
  tData = ThisWorkbook.Worksheets("Liste Concerts").Range("A3").CurrentRegion.Value

  Application.ScreenUpdating = False
  Dim i As Long
  For i = LBound(tData, 1) To UBound(tData, 1)
    With ThisWorkbook.Worksheets
      'copie du template
      templateSht.Copy After:=.Item(.Count)
      ' remplissage des valeurs
      WriteRecordToSht RecordFromRow(tData, i), .Item(.Count)
    End With
  Next i
  Application.ScreenUpdating = True
End Sub

Private Sub WriteRecordToSht(ByRef concertRcd As DataRecord, ByRef ws As Worksheet)
  ' cette fonction definie les cellules "où" inserer les infos
  ws.Range("B3").Value = concertRcd.Num
  ws.Range("A6").Value = concertRcd.Ddate
  ws.Range("B6").Value = concertRcd.Comm
  ws.Range("C6").Value = concertRcd.Salle
  ws.Range("A11").Value = concertRcd.Orga
  ws.Range("B11").Value = concertRcd.Tel
  ws.Range("C11").Value = concertRcd.Email
End Sub

Private Function RecordFromRow(tbl As Variant, rowI As Long) As DataRecord
  ' cette fonction recupere les infos dans la feuille source
  With RecordFromRow
    .Num = tbl(rowI, 1)
    .Comm = tbl(rowI, 2)
    .Salle = tbl(rowI, 3)
    .Ddate = tbl(rowI, 4)
    .Orga = tbl(rowI, 5)
    .Tel = tbl(rowI, 6)
    .Email = tbl(rowI, 7)
  End With
End Function

Un grand merci .
Bien incapable de faire tout çà !!