XL 2010 suppression de ligne en fin de boucle

[Chasse]

Bonjour le forum

J’aimerais stocker les lignes et les supprimer toutes en même temps à la fin de la boucle

Que doit-je ajouter à ses instructions et ou les mettres

Sub Archivage()
Set Arch = Sheets("Archive")

    For Each sh In Sheets
        Fin = sh.Range("B100000").End(xlUp).Row
        finB = sh.Range("F100000").End(xlUp).Row
        Rt = Arch.Range("A100000").End(xlUp).Row
        
        If sh.Name = "Rouge" Or sh.Name = "Blanc" Or sh.Name = "Rosé" Or sh.Name = "Champagne" Then
        sh.Select
            For g = 2 To Fin Step -1
            bt = sh.Cells(g, 2).End(xlDown).Row
                If Cells(g, 1) = 0 And Rows.Cells(g, 1).Row = Fin Then
                    Range(Cells(g, 2), Cells(finB, 6)).Copy
                    For i = 1 To Rt
                        If Arch.Cells(i, 1) = "Appellation" & " " & sh.Name Then
                            Arch.Cells(i, 1).Offset(1, 0).Insert Shift:=xlDown
                            Rows(g & ":" & finB).Select '.Delete
                        End If
                    Next
                  
                ElseIf Cells(g, 1) = 0 And Cells(g, 2) <> "" Then
                    Range(Cells(g, 2), Cells(bt, 6).Offset(-1, 0)).Copy
                    For i = 1 To Rt
                        If Arch.Cells(i, 1) = "Appellation" & " " & sh.Name Then
                            Arch.Cells(i, 1).Offset(1, 0).Insert Shift:=xlDown
                            Rows(g & ":" & bt - 1).Select '.Delete
                        End If
                    Next
                End If
            Next
        End If
    Next
 End Sub

D'avance merci à bientôt,et prenez soin de vous!

 

[_Thierry]

Bonjour @Chasse , le Forum

Si c'est en appliquant ce genre de Copy, tu ne pourras le faire qu'une fois

Range(Cells(g, 2), Cells(finB, 6)).Copy

A l'instruction suivante de Copy

Range(Cells(g, 2), Cells(bt, 6).Offset(-1, 0)).Copy

Le ClipBoard sera effacé.

Tu dois t'orienter pour mettre ceci dans un Tableau (Array)

Dim Destination As Range
Dim MyArr1() As Variant

'.... Blah Blah Blah
MyArr1 = Range(Cells(g, 2), Cells(finB, 6))

'.... tes instructions/loop etc...

'.... Blah blah blah

Set Destination = Worksheets("LaFeuilleVoulue").Range("A1")
Set Destination = Destination.Resize(UBound(MyArr1), 1)
Destination.Value = Application.Transpose(MyArr1)

Et ainsi de suite MyArr2, etc...

Bonne journée
@+Thierry

 

[Chasse]

Bonjour Thierry
Merci pour ton aide
Mes connaissances en VBA étant limitées et en anglais quasi nul je suis largué
De quelle tableau parle-tu ?

Tu dois t'orienter pour mettre ceci dans un Tableau (Array)

j'ai juste besoin que VBA mémorisé les numéros de ligne

Rows(g & ":" & finB).Delete
Rows(g & ":" & bt - 1).Delete

et les supprime en une seule fois avant de
passer à la feuille suivante

Si cela n’ai pas possible alors la boucle devrais commencer par la fin mais là non plus je ne sait pas comment m'y prendre.
ci-joint un fichier

cordialement

 

[_Thierry]

Re Bonjour
Dans ce cas tu déclares un Compteur (ou plusieurs Compteurs) en Début de Sub...

Sub Archivage()
Dim MyCounterA as Long, MyCounterB as Long 'etc...

Et dans la boucle qui t'interresse, tu mets
MyCounterA = MyCounterA + 1

Tu devras tenir compte de décaler à 1 de moins si tu démarres ta plage à 2, pour tomber sur le bon numéro de la ligne...

Bon courage
@+Thierry