VBA condition copie colle

[eramond]

Bonjour le forum

Encore un copier coller mais avec des conditions.

Je souhaite copier coller des cellules dans un autre feuille mais avec des conditions :

J'avais bricolé cette formule mais je souhaite l'optimiser :

Sub Copy_paste()
'
    Dim WsScr As Worksheet, WsDest As Worksheet, MaPlage As Range
 
    Set WsScr = Worksheets("Données")
    Set MaPlage = WsScr.Range("A2:I4000").SpecialCells(xlCellTypeVisible)
    ' special cell ne copie que les cellules visibles a enlever si on veut tout'
  
     
  ' colle dans feuille prédéfinie'
  
    Set WsDest = Worksheets("DV-en-retard")
    MaPlage.SpecialCells(xlVisible).Copy WsDest.Range("A2")

Je veux copier les cellules qui contiennent le mot "yes" dans la colonne D de ma feuille Données, et les coller dans la premiere ligne vide de ma feuille DV en retard

Comment faire ?

Merci

 

[Calvus]

Re : VBA condition copie colle

Bonsoir,

Pas testé :

for each cel in Maplage
If cel = yes Then
Feuil2.Range("A & Rows.count.End(XlUp).(2) = cel
End If
Next cel

Dis nous

A+

 

[Paf]

Re : VBA condition copie colle

Bonjour eramond, Calvus

En passant par le filtre automatique, faire le tri sur "yes" colonne D et copier les lignes visibles

Sub Copy_paste()
'
    Dim WsScr As Worksheet, WsDest As Worksheet, MaPlage As Range
    Dim DerL1 As Long, DerL2 As Long
 
    Set WsScr = Worksheets("Données") 'feuille Source
    Set WsDest = Worksheets("DV-en-retard") ' feuille cible

    DerL1 = WsScr.Range("A" & Rows.Count).End(xlUp).Row 'dernière ligne de données
    Set MaPlage = WsScr.Range("A2:I" & DerL1)

    'met la feuille source en mode filtre si elle ne l'est pas
    If Not WsScr.AutoFilterMode Then MaPlage.AutoFilter

    'tri selon  les critères colonne D
    MaPlage.AutoFilter Field:=4, Criteria1:="yes"

    'détermination de la ligne dispo feuille cible
    DerL2 = WsDest.Range("A" & Rows.Count).End(xlUp).Row + 1

    'copie la feuille origine filtrée  sur la feuille cible
    ' special cell ne copie que les cellules visibles a enlever si on veut tout'
    MaPlage.SpecialCells(xlCellTypeVisible).Copy WsDest.Range("A" & DerL2)


...
...
End Sub

A+

 

[eramond]

Re : VBA condition copie colle

Merci de vos retours, j'ai essayé mais cela ne fonctionne pas.

Un fichier test.

 

[Paf]

Re : VBA condition copie colle

re,

Merci de vos retours, j'ai essayé mais cela ne fonctionne pas.

ce n'est pas d'une grande précision mais on a fait avec.

une nouvelle mouture basée sur la proposition de Calvus, sans doute moins rapide s'il y a beaucoup de lignes à traiter, mais qui fonctionne:

Sub Copy_paste()
 Dim WsScr As Worksheet, WsDest As Worksheet, MaPlage As Range
 Dim DerL1 As Long, DerL2 As Long, Cel As Range
 
 Set WsScr = Worksheets("Données") 'feuille Source
 Set WsDest = Worksheets("DV-en-retard") ' feuille cible
    
 DerL1 = WsScr.Range("A" & Rows.Count).End(xlUp).Row 'dernière ligne de données
 Set MaPlage = WsScr.Range("A2:I" & DerL1)
 Application.ScreenUpdating = False

 For Each Cel In MaPlage.Columns(4).Rows
    If Cel Like "Yes*" Then
        DerL2 = WsDest.Range("A" & Rows.Count).End(xlUp).Row + 1
        MaPlage.Rows(Cel.Row - 1).Copy
        WsDest.Range("A" & DerL2).PasteSpecial xlPasteValues
        Application.CutCopyMode = False
    End If
 Next Cel
 Application.ScreenUpdating = True
End Sub

A+

 

[Calvus]

Re : VBA condition copie colle

Bonsoir Paf, le fil,

Paf, peux tu m'expliquer pourquoi ce code ne fonctionne pas ? Il ne fait la boucle qu'une seule fois...

[Highlight=vb]Sub Copier()
For Each cel In Sheets("Données").Range("A2").End(xlDown)
'MsgBox (cel.Offset(, 3))
If cel.Offset(, 3) = "yes" Then
Sheets("Feuil4").Range("C" & Rows.Count).End(xlUp).Rows(2) = cel
End If
Next cel

End Sub
[/code]

Merci et bonne soirée

 

[Paf]

Re : VBA condition copie colle

re Calvus,

Sheets("Données").Range("A2").End(xlDown) est une plage constituée de la dernière cellule non vide de la colonne A.

1 seule cellule => 1 seule boucle

Il faut déterminer une plage du type : A2:A10. une des façons de l'écrire:

Sheets("Données").Range("A2:A" & Range("A2").End(xldown).Row)

A+

 

[Calvus]

Re : VBA condition copie colle

Re,

Ok;merci. Je me suis mis dedans sur ce coup là mais c'est parce que j'ai fait plein d'essais et que j'y ai perdu mon latin

Ce que je voulais te demander concerne ce code :

Sheets("Données").Range("A" & Rows.Count).End(xlUp).Rows(1)

Si je n'ai pas fait d'erreur dans ma syntaxe.

Merci

 

[Paf]

Re : VBA condition copie colle

Re,

C'est exactement le même soucis,

Sheets("Données").Range("A" & Rows.Count).End(xlUp) détermine la dernière cellule non vide de la colonne A.

le fait de rajouter .Rows(1) en fin d'instruction ne fait que sélectionner la première ligne de la plage définie par cette instruction ( qui ne contient que la dernière cellule non vide de la colonne A)

A+

 

[Calvus]

Re : VBA condition copie colle

Re,

Je comprends.

Alors quel est le moyen avec rows.count ? S'il y en a un ? De faire comme tu as fait ?

+

 

[Paf]

Re : VBA condition copie colle

re,

je veux une plage de la forme range("A2:Axx")

je détermine xx (la dernière ligne de la plage) par Range("A" & Rows.Count).End(xlUp).Row

je détermine ma plage :

range("A2:A" & Range("A" & Rows.Count).End(xlUp).Row)

dans les propositions, j'avais décomposé comme ceci, mais c'est le même résultat:

Derl=Range("A" & Rows.Count).End(xlUp).Row

MaPlage=range("A2:A" & Derl)

A+

 

[Calvus]

Re : VBA condition copie colle

Ok, super ! Merci !

A bientôt

 

[Paf]

Re : VBA condition copie colle

pour Calvus

une autre façon d'écrire avec rows.count:

Range("A2", Cells(Rows.Count, 1).End(xlUp))

A+

 

[Calvus]

Re : VBA condition copie colle

Bonjour,

Merci Paf ! Ça c'est la classe !

A bientôt

 

[eramond]

Re : VBA condition copie colle

Bonjour

J'ai essayé le code proposé mais cela ne fonctionne pas rien ne s'affiche.

JE ne comprends pas pourquoi