Regrouper plusieurs feuilles en une seule

Bonjour,

Je souhaiterais faire une macro mais j'ai des petits soucis.

J'explique le contexte.

J'ai un fichier qui contient plusieurs feuilles.

J'aimerais dans une feuille appelée "Essai" faire un recap de toutes mes autres feuilles (càd les copier coller l'une à la suite de l'autre) en supprimant les lignes dont la première case est soit vide soit contient le terme "Type of items". Et je voudrais que la synchro se fasse automatiquement, càd que lorsque je modifie une cellule d'une de mes feuilles, cela modifie automatiquement la cellule correspondante dans ma feuille "Essai".

J'ai fait la macro ci-dessous qui marche bien. Le seul souci, c'est que ça prend un certain temps pour supprimer les lignes qui ne contiennent rien ou "Type of items" car la macro que j'ai fait parcourt toutes les lignes de ma feuille "Essai" (environ 2700 lignes) et surtout je suis obligée de relancer ma macro à chaque fois que je fais une modif dans une des autres feuilles...

Je ne sais pas si j'ai été claire.. Si qqun a une solution !

Merci

Sub RecapActualiser()

Dim Lg&, Sh As Worksheet, f As Worksheet
Dim LastRow As Integer
Dim Last As Integer

        Set f = Sheets("Essai")
    f.Range("a2:z" & f.[a65000].End(xlUp).Row).ClearContents    'efface Recap

    For Each Sh In Worksheets
        If Sh.Name = "LIL_PROD" Or Sh.Name = "PAR_PROD" Or Sh.Name = "SDE_PROD" Or Sh.Name = "MAR_PROD" Or Sh.Name = "NIC_PROD" Or Sh.Name = "BOR_PROD" Or Sh.Name = "LEN_PROD" Or Sh.Name = "TOU_PROD" Or Sh.Name = "SET_PROD" Then                          'feuille Recap à ne pas traiter
            Lg = Sh.Range("a" & Rows.Count).End(xlUp).Row
            Sh.Range("a8:z" & Lg).Copy Destination:= _
            f.Range("a" & Rows.Count).End(xlUp)(2)
            LastRow = Worksheets("Essai").Range("A65536").End(xlUp).Row
            Last = LastRow + 1
            Rows(Last).Resize(10).Insert shift:=xlDown
        End If
    Next

LastRow = f.Range("B" & "65536").End(xlUp).Row

For i = LastRow To 2 Step -1
    If f.Cells(i, 1) = "" Or f.Cells(i, 1) = "Type of items" Then
        Rows(i).Delete
    End If
Next i

End Sub

Bonjour,

Merci de joindre un fichier anonymisé représentatif de tes données (quelques lignes par feuille suffiront).

Cdlt.

Bonjour,

Merci de ta réponse. Je suis désolée mais je n'ai pas le temps de modifier mon fichier pour le mettre en ligne. Mais comme mon programme marche, je vais me contenter de ce que j'ai fait.

Juste une petite question, tu auras peut être la réponse. Lorsque je charge ma macro, elle m'efface à chaque fois la ligne 1 de ma feuille Essai. Or je voudrais conserver les données de cette ligne qui représente en fait l'en-tête de mes colonnes. Une idée ?

Re,

Essaie ceci :

f.Range("a2:z" & f.[a65000].End(xlUp).Row).Offset(1,0).ClearContents

Ca marche nickel !! Merci beaucoup !