Copy Paste sous condition

Question

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

Configuration: Windows XP / Internet Explorer 8.0

G_33 · Answer

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

michel_m · Answer

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

Copy Paste sous condition

2 réponses

Discussions similaires

Newsletters