XL 2010 suppression de ligne en fin de boucle

Chasse

XLDnaute Occasionnel
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
VB:
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

XLDnaute Barbatruc
Repose en paix
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)
VB:
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

XLDnaute Occasionnel
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
Code:
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
 

Pièces jointes

  • cave 10 mai.xlsm
    60.4 KB · Affichages: 5

_Thierry

XLDnaute Barbatruc
Repose en paix
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
 

Discussions similaires

Réponses
4
Affichages
165

Statistiques des forums

Discussions
311 729
Messages
2 081 971
Membres
101 852
dernier inscrit
dthi16088