Je souhaiterai rajouter la ligne d'entête sur toute les feuilles

Fermé
Olivier8192 Messages postés 2 Date d'inscription vendredi 23 octobre 2020 Statut Membre Dernière intervention 27 octobre 2020 - Modifié le 23 oct. 2020 à 15:34
yg_be Messages postés 22722 Date d'inscription lundi 9 juin 2008 Statut Contributeur Dernière intervention 25 avril 2024 - 26 oct. 2020 à 17:32
Bonjour,

Je souhaiterai rajouter la ligne d'entête sur toute les feuilles de mon découpage de fichier je vous fais suivre mon VBA du découpage qui fonctionne bien mais ne reprend pas cette ligne.

Par avance merci

Sub creation_onglets()
Dim Ws As Worksheet
Dim trouve As Boolean
Dim contenu As String
Dim lig, derlig As Integer
With Sheets("TEST") 'à adapter Feuil1 = feuille ou sont vos données
derlig = .Range("A65536").End(xlUp).Row 'à adapter, E = colonne "Dossier groupe"
For lig = 2 To derlig
contenu = .Cells(lig, 1).Value 'à adapter 5 = 5ème col cf E 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
End Sub
A voir également:

6 réponses

f894009 Messages postés 17185 Date d'inscription dimanche 25 novembre 2007 Statut Membre Dernière intervention 15 avril 2024 1 701
23 oct. 2020 à 16:48
Bonjour,

Avec votre code, les infos de la ligne trouvee sont bien copiees!!
Pige pas ce que vous avez comme anomalie?
0
Olivier8192
23 oct. 2020 à 18:09
Bonjour,

La première ligne avec le nom des colonnes n’ait pas copié dans les feuilles découpées, la copie commence en 2 émet ligne

Merci pour votre retour
0
f894009 Messages postés 17185 Date d'inscription dimanche 25 novembre 2007 Statut Membre Dernière intervention 15 avril 2024 1 701
24 oct. 2020 à 07:43
Bonjour,

Ben oui mais votre code ne copie qu'une seule ligne!
0
Olivier8192
24 oct. 2020 à 07:54
Bonjour,

Non elle copie bien toute les lignes qui ont la même référence dans la première colonne en copiant se nom sur l’onglet crée.
Cordialement
0
f894009 Messages postés 17185 Date d'inscription dimanche 25 novembre 2007 Statut Membre Dernière intervention 15 avril 2024 1 701
24 oct. 2020 à 11:29
Re,

Ben, mettez votre fichier a dispo car avec ce que j'ai fait comme test: pas vrai

Pour transmettre un fichier,
Veillez a ce qu'il n'y ait PAS DE DONNEES CONFIDENTIELLES
il faut passer par un site de pièce jointe tel que cjoint.com

Allez sur ce site : https://www.cjoint.com/
Clic sur parcourir,
Cherche ton fichier,
clic sur ouvrir,
Clic sur "Créer le lien cjoint",
Copier le lien,
Revenir ici le coller dans une réponse...

ou
'mon partage
https://mon-partage.fr/
0
yg_be Messages postés 22722 Date d'inscription lundi 9 juin 2008 Statut Contributeur Dernière intervention 25 avril 2024 1 476
24 oct. 2020 à 11:53
bonjour,
la logique du code est probablement viciée, peut-être à cause du
Exit For
.
cependant, tu ne décris pas ce que tu veux réaliser.
For lig = 2 To derlig
    For Each Ws In ThisWorkbook.Worksheets
        If StrComp(Ws.Name, contenu, vbTextCompare) = 0 Then
             Exit For
        End If
    Next Ws
    If trouve = True Then
    Else
    End If
Next lig
0
yg_be Messages postés 22722 Date d'inscription lundi 9 juin 2008 Statut Contributeur Dernière intervention 25 avril 2024 1 476
24 oct. 2020 à 11:57
un code, surtout si il ne fonctionne pas, ne peut pas remplacer une description claire de l'objectif.
0
Olivier8192
26 oct. 2020 à 17:27
Bonjour ye_be,

Merci pour votre aide, sa fonctionne.

Si je peux abuser, s'avez vous si il y a une méthode pour mettre plus de 31 caractères pour le nom des onglets.

Merci
0
yg_be Messages postés 22722 Date d'inscription lundi 9 juin 2008 Statut Contributeur Dernière intervention 25 avril 2024 1 476 > Olivier8192
26 oct. 2020 à 17:32
je pense que non.
0

Vous n’avez pas trouvé la réponse que vous recherchez ?

Posez votre question
f894009 Messages postés 17185 Date d'inscription dimanche 25 novembre 2007 Statut Membre Dernière intervention 15 avril 2024 1 701
24 oct. 2020 à 12:05
Bonjour yg_be,

le hic c'est a mon avis ceci:
la copie commence en 2 émet ligne
son code le fait:
.Rows(lig).Copy Sheets(contenu).Range("A65536").End(xlUp).Offset(1, 0)

mais a quelle ligne cela doit etre?
0
yg_be Messages postés 22722 Date d'inscription lundi 9 juin 2008 Statut Contributeur Dernière intervention 25 avril 2024 1 476
24 oct. 2020 à 12:15
sans doute changer la ligne 22 en:
.Rows(1).Copy Sheets(contenu).Range("A1")
.Rows(lig).Copy Sheets(contenu).Range("A2")
0
yg_be Messages postés 22722 Date d'inscription lundi 9 juin 2008 Statut Contributeur Dernière intervention 25 avril 2024 1 476 > yg_be Messages postés 22722 Date d'inscription lundi 9 juin 2008 Statut Contributeur Dernière intervention 25 avril 2024
24 oct. 2020 à 12:26
ceci serait plus clair:
Sub creation_onglets()
Dim Ws As Worksheet, nouv As Worksheet, contenu As String, trouve As Boolean
Dim lig As Long, derlig As Long
With Sheets("TEST") 'à adapter Feuil1 = feuille ou sont vos données
    derlig = .Range("A65536").End(xlUp).Row 'à adapter, E = colonne "Dossier groupe"
    For lig = 2 To derlig
        contenu = .Cells(lig, 1).Value 'à adapter 5 = 5ème col cf E ci dessus
        trouve = False
        For Each Ws In ThisWorkbook.Worksheets
            If StrComp(Ws.Name, contenu, vbTextCompare) = 0 Then
                trouve = True
                .Rows(lig).Copy Ws.Range("A65536").End(xlUp).Offset(1, 0)
                Exit For
            End If
        Next Ws
        If Not trouve Then
            Set nouv = Sheets.Add
            nouv.Name = contenu
            .Rows(1).Copy nouv.Range("A1")
            .Rows(lig).Copy nouv.Range("A2")
        End If
    Next lig
End With
End Sub
0
Olivier8192 > yg_be Messages postés 22722 Date d'inscription lundi 9 juin 2008 Statut Contributeur Dernière intervention 25 avril 2024
26 oct. 2020 à 17:29
Bonjour yg_be,

Merci pour votre retour, je n’a Pas accès actuellement à mon ordi, je test lundi et reviens vers vous.

Bien cordialement
Olivier
0
Olivier8192
24 oct. 2020 à 17:09
Bonjour yg_be,

Merci pour votre retour, je n’a Pas accès actuellement à mon ordi, je test lundi et reviens vers vous.

Bien cordialement
Olivier
0