Supprimer cellules non vides après une cellule définie

Bonjour à tous !

Etant en alternance dans une entreprise, j'ai pour projet de développer la base de donnée et je me heurte à quelques soucis.

Dans un premier temps j'ai récupéré une formule VBA qui me permet de copier toutes les cellules de ma colonne tant que la valeur de ma colonne est différente de "Total général".

Malheureusement je souhaiterai modifier mon code afin de pouvoir supprimer toutes les autres cases qui suivent la case "Total général".

En d'autre termes, je me retrouve avec une première liste de 40 cellules que j'ai copié. Si je change ma liste d'entrée (celle que j'ai copié) et qu'elle passe à 20 (par exemple), je me retrouve avec les 20 cellules que je veux MAIS également les 20 cellules de mon précédent copier/coller. Et ce sont ces cases "en trop" que je souhaiterai supprimer.

Voici le code que j'ai pour faire mon copier coller et auquel je souhaiterai y ajouter ma fonction de suppression :

Sub Recopie()

Application.ScreenUpdating = False

With Sheets("Feuil2")
i = 5
    Do While Cells(i, 1) <> "Total général"
        .Range(Cells(i, 1), Cells(i, 1)).Copy Destination:=Sheets("Annexe 7").Cells(i - 1, 2)
    i = i + 1
    Loop

End With

Application.ScreenUpdating = True

End Sub

J'espère que vous pourrez m'aider

Merci d'avance !

Julien

Bonjour

Tu devrais joindre ton fichier en mettant sur une autre feuille en guise d'exemple, ce que tu veux obtenir.

Bye !

Bonjour

Désolé pour le temps de réponse mais n'ayant le fichier qu'au travail je ne pouvais pas faire un extract plus tôt

Voici l'extract de mon fichier. vous pourrez voir que cela fonctionne mais que les lignes ne se suppriment pas et ce que je souhaiterai comme demandé plus haut.

Je souhaite procéder ainsi pour des soucis de taille de fichier. J'ai évidement pensé à faire un simple tri mais vu le nombre de ligne le fichier sera extrêmement lourd et ce n'est pas possible...

J'espère que vous saurez m'aider

D'avance merci !

Julien

Bonjour

Essaie ça :

Sub Recopie()

    Application.ScreenUpdating = False
    Set f = Sheets("Annexe 7")
    f.Range("B4:B" & Application.Max(4, f.Range("B" & Rows.Count).End(xlUp).Row)).Clear
    With Sheets("Feuil2")
    i = 5
        Do While Cells(i, 1) <> "Total général"
            .Range(Cells(i, 1), Cells(i, 1)).Copy Destination:=Sheets("Annexe 7").Cells(i - 1, 2)
        i = i + 1
        Loop
    End With
    Application.ScreenUpdating = True
End Sub

Résultat ?

Bye !

Résultat c'est exactement ce que je souhaitai !

Merci beaucoup !!!