Copy Paste sous condition

Fermé

abc - 3 oct. 2012 à 15:40
abc - 8 oct. 2012 à 10:43

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

A voir également:

Copy Paste sous condition
Excel cellule couleur si condition texte - Guide
Super copy - Télécharger - Gestion de fichiers
Copy trans - Télécharger - Sonneries
Copy trans heic - Télécharger - Visionnage & Diaporama
Recherchev avec condition si ✓ - Forum Excel

2 réponses

Réponse 1 / 2

G_33
3 oct. 2012 à 18:37

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

aaa
8 oct. 2012 à 10:42

merci!

Réponse 2 / 2

michel_m Messages postés 16603 Date d'inscription lundi 12 septembre 2005 Statut Contributeur Dernière intervention 16 décembre 2023 3 303
Modifié par michel_m le 4/10/2012 à 09:59

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

abc
8 oct. 2012 à 10:43

Je vais essayer!Merci

Discussions similaires

Bloquer des cellules sous conditions

Excel : colorer une cellule sous condition d'une autre ?

Copie automatique tableau Excel sans macro

copier tout un répertoire sous dos

Masquer lignes d'un tableau sous conditions de cellules

Discussions similaires

Newsletters