Récupération première ligne

Bonjour,

Je n'arrive pas à récuperer la première ligne de mon classeur qui représente les entêtes de mes colonnes. Ma macro fait bien la création d'un fichier par critère trouvé dans la colonne 4 mais je n'arrive pas sur chaque fichier créer à récupérer l’entête qui est commune dans mon source.

Sub ventil()
Dim ws As Worksheet
Dim newWk As Workbook
Dim trouve As Boolean
Dim contenu As String
Dim lig, derlig As Integer
With Sheets("Sheet1") '(1) à adapter Feuil1 = feuille ou sont vos données
derlig = .Range(" D65536 ").End(xlUp).Row '(2) à adapter, D = colonne " Dossier groupe "
For lig = 2 To derlig
contenu = .Cells(lig, 4).Value '(3) à adapter 4 = 4ème col cf D ci-dessus
For Each ws In ThisWorkbook.Worksheets
trouve = False
        If StrComp(ws.Name, contenu, vbTextCompare) = 0 Then
            trouve = True
            Exit For
        End If
Next ws
If trouve = True Then
        .Rows(lig).Copy Sheets(contenu).Range("A65536").End(xlUp).Offset(1, 0)
    Else
        Sheets.Add
        ActiveSheet.Name = contenu
        .Rows(lig).Copy Sheets(contenu).Range("A65536").End(xlUp).Offset(1, 0)
End If
Next lig
End With

    For Each ws In Worksheets
        Set newWk = Workbooks.Add(xlWBATWorksheet)
        ws.Copy newWk.Sheets(1)
        newWk.SaveAs (ThisWorkbook.Path & "\" & ws.Name & ".xlsx")
        newWk.Close
        Set newWk = Nothing
    Next ws

End Sub

Merci d'avance pour votre aide.

bonjour e bienvenue

un fichier serias mieu pour le test

mais n'empeche

essais cela

For lig = 1 To derlig

qui remplacera

For lig = 2 To derlig

a vous relire

Merci pour votre réponse mais déjà essayé, cela ne me met pas la première ligne dans chaque fichier,

mais me génère un fichier avec simplement la première ligne puis les autres avec le reste en fonction toujours de la cellule en colonne 4.

Bonjour,

Si ton code était correctement indenté, on n'aurait moins de mal à s'y retrouver...!

C'est ton code lors d'ajout de feuille qui est à revoir :

       Sheets.Add
        ActiveSheet.Name = contenu
        .Rows(1).Copy Sheets(contenu).Range("A1")
        .Rows(lig).Copy Sheets(contenu).Range("A2")

Cordialement.

Merci beaucoup marche nickel.