Gestion des feuilles avec plus de 200 lignes

Bonjour à tous,

mon classeurs comporte plusieurs feuilles avec un nombre de ligne variable.

Je voudrai que ma macro me duplique chaque feuille de plus de 200 lignes. Avec sur la feuille (feuill1) les lignes de 1 à 199 et la feuille dupliquée (feuil1(2)) les lignes de 200 à xxx (la dernière ligne). La ligne 1 étant celle des en-têtes que je souhaite conserver.

Mais là, j'avoue que je ne sais pas comment faire.

Pouvez vous m'aider?

A vous lire.

Bonjour,

Merci de joindre un petit fichier à ta demande.

Cdlt.

Mon fichier comporte 3 onglets dont:

onglet R-Malicol avec moins de 200 lignes

onglet R-Preformed avec plus de 200 lignes, que je souhaite scinder.

onglet R-Preformed (2), que j'ai créé manuellement dans lequel je souhaite transférer les lignes de 200 à xxx

A vous lire.

Bonjour,

Voilà un fichier à tester !

A plus !

Merci Braters,

la création de la feuille et le transfert des lignes , c'est parfait.

Par contre si ma ligne 1 contient l'en-tête, je souhaite la conserver sur la nouvelle feuille.

NB: l'en-tête est commun à toutes les feuilles, c'est plus simple peut-être?

A te lire.

Bonjour,

Une proposition à étudier.

ALT F8, exécuter la procédure.

Cdlt.

pcaille a écrit :

Merci Braters,

la création de la feuille et le transfert des lignes , c'est parfait.

Par contre si ma ligne 1 contient l'en-tête, je souhaite la conserver sur la nouvelle feuille.

NB: l'en-tête est commun à toutes les feuilles, c'est plus simple peut-être?

A te lire.

Re,

Voilà c'est corrigé, mais je crois bien que la macro de Jean-Eric est bien plus performante lol

A plus !

Re,

j'ai modifié un peu ta macro comme suit pour l'adapter à mes besoins:

For Each Ws In ActiveWorkbook.Worksheets

Malheureusement j'obtiens un code erreur.

Sur ton fichier tout est ok.

As tu une idée sur le pourquoi??

A te lire.

Re,

J'ai corrigé comme suit:

        Ws.Range("A200:AB" & Derlig).Cut

Maintenant c'est ok, par contre comment faire pour recopier la mise en forme de mon en-tête?

A te lire...

Re,

Il semble que tu m'ignores.

Ce n'est pas une bonne attitude.

Ma proposition revue :

Option Explicit

Public Sub Consolidate_Data()
Dim wb As Workbook
Dim ws As Worksheet, ws2 As Worksheet
Dim lrow As Long

    Application.DisplayAlerts = False
    Application.ScreenUpdating = False

    Set wb = ThisWorkbook

    On Error Resume Next
    wb.Worksheets("Consolidation").Delete
    On Error GoTo 0

    Application.DisplayAlerts = True

    Set ws2 = wb.Worksheets.Add(after:=Worksheets(Worksheets.Count))
    ws2.Name = "Consolidation"
    lrow = 1

    For Each ws In wb.Worksheets
        If ws.Name <> ws2.Name Then
            If lrow = 1 Then
                ws.Cells(1).CurrentRegion.Copy Destination:=ws2.Cells(lrow, 1)
                lrow = ws2.Cells(Rows.Count, 1).End(xlUp).Row + 1
            Else
                ws.Cells(1).CurrentRegion.Offset(1).Copy Destination:=ws2.Cells(lrow, 1)
            End If
        End If
    Next ws

End Sub

Bonsoir Jean-Éric,

Loin de moi l'idée de te chagriner

La macro de Braters était plus facilement transposable à mes besoins. Et surtout plus compréhensible vu mon niveau en VBA

Néanmoins je vais essayer ta macro et voir comment l'utiliser pour résoudre mon problème d'en-tête.

Merci de ton aide.

Re,

Prends ton temps et si tu le souhaites, je peux commenter la procédure.

Cdlt.

Re,

si ca ne te prend pas trop de temps, je suis preneur.

A te lire.

Re,

J'ai commenté la procédure dans le fichier joint.

ALT F11, voir modConsolidateData.

A te relire.

Cdlt.

Merci Jean Eric pour toutes les explications, c'est quand même plus clair.

Néanmoins la macro de Braters est plus proche du résultat que je recherche. Mais je conserve la tienne sous le coude pour une autre idée.

Encore merci.

pcaille,

voilà c'est modifié pour coller le format des en-têtes !

Sub duplique()

Dim Ws As Worksheet
Dim Derlig%

For Each Ws In ActiveWorkbook.Worksheets
    Derlig = Ws.Cells(Rows.Count, 1).End(xlUp).Row
    If Derlig >= 200 Then
        Sheets.Add After:=Sheets(Ws.Index)
        ActiveSheet.Name = Ws.Name & " (2)"
        Ws.Rows(1).Copy
        ActiveSheet.Range("A1").PasteSpecial xlPasteAll
        Ws.Range("A200:AB" & Derlig).Cut
        ActiveSheet.[A2].Select
        ActiveSheet.Paste
    End If
Next Ws

End Sub

A plus !

Merci pour le coup de main, c'est parfait.

A bientôt sur le forum.