Copy Paste sous condition

[Fermé]
Signaler
-
 abc -
Bonjour,

Je voudrais supprimer des colonnes en fonction d'une valeur dans une colonne. Jusqu'ici tout va bien.


Puis Je voudrais copier un certains nombre de lignes en fonctions de la valeur présente dans une autre colonne, dans une nouvelle feuille créee dans le code. J'aimerai que les lignes contenant la même valeur de référence crée un bloc distinct séparé d'une dizaine de lignes.

Voici le code que j'ai jusqu'à maintenant:


Sub Ordering()


Application.ScreenUpdating = False
Worksheets("02.10.2012").Activate
Dim I As Double
For I = 38000 To 2 Step -1
If Cells(I, 2) = "" Then
Rows(I).Delete
End If

If Cells(I, 21) = "1100" Then
Rows(I).Select
Rows(I).Copy
ActiveWindow.NewWindow
Rows(I).Paste
End If

If Cells(I, 21) = "1140" Then
Rows(I).Select
Rows(I).Copy
ActiveWindow.NewWindow
Rows(I).Paste
End If

Next I

Application.ScreenUpdating = True

'
End Sub

2 réponses

Bonsoir
Voilà ce que je vous propose
A adapter bien sur surtout pour le nom des feuilles
Sub Ordering()
Application.ScreenUpdating = False
Worksheets("Feuil1").Activate
Dim I As Long
For I = 1 To Range("A" & Rows.Count).End(xlUp).Row
    Sheets("Feuil1").Activate
    If Sheets("Feuil1").Cells(I, 2) = "" Then
        Rows(I).Delete
        I = I - 1
    End If
    If Sheets("Feuil1").Cells(I, 21) = "1100" Then
        'Rows(I).Select
        Rows(I).Copy
        maligne = Sheets("Feuil2").Range("A" & Rows.Count).End(xlUp).Row
        maligne = maligne + 1
        Sheets("Feuil2").Activate
        Range(Cells(maligne, 1), Cells(maligne, 1)).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
                               :=False, Transpose:=False
         Application.CutCopyMode = False
    End If
    If Cells(I, 21) = "1140" Then
        Rows(I).Copy
        Sheets("Feuil2").Activate
        maligne = Sheets("Feuil2").Range("A" & Rows.Count).End(xlUp).Row
        maligne = maligne + 1
        
        Range(Cells(maligne, 1), Cells(maligne, 1)).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
                               :=False, Transpose:=False
        Application.CutCopyMode = False
    End If
Next I
Application.ScreenUpdating = True
Application.CutCopyMode = False
MsgBox "TERMINE"
End Sub


en VBA eviter les select et bien déclarer les variables.
Bonne continuation
Messages postés
16527
Date d'inscription
lundi 12 septembre 2005
Statut
Contributeur
Dernière intervention
23 octobre 2021
3 232
Bonjour,

Ton tableau de départ semble très grand : pourrais tu me dire le nombre de colonnes (21 ?) et de lignes (38000 ?) ?

Pour effectuer ce que tu veux faire sans attendre plusieurs minutes il y a des techniques qui évitent les copy-paste, worksheets("xxx").activate, etc. très "chronophages" pour employer un mot à la mode. de m^me on peut parfois éviter des boucles, par exemple pour supprimer une ligne si un vide dans une colonne :

Dim Derlig As Long  

Derlig = Columns("B").Find("*", , , , , xlPrevious).Row  

If Application.CountIf(Range("B1:B" & Derlig), "") > 0 Then  
     Range("B1:B" & Derlig).SpecialCells(xlCellTypeBlanks).EntireRow.Delete  
End If 


Si ça t'intéresse, tu dis...
au besoin tu mets en pièce jointe un extrait de ton classeur

pour joindre une pièce
mettre le classeur sans données confidentielles en pièce jointe sur
https://www.cjoint.com/
puis copier l'adresse du lien et la coller dans le message de réponse



Michel
Je vais essayer!Merci