Copier Coller avec condition

[monkeyspace]

Bonsoir à tous,

J'ai un petit avec un code VBA pourtant assez connu sur ce forum ( j'ai cherché pour adapter un code fonctionnel mais pas trouvé ou du moins pas sur de moi) , le copier coller avec condition.

J'ai un classeur Excel qui possède deux feuilles : liste salariés et récap salariés.
Je cherche le moyen de copier seulement les lignes A:H de la feuille liste salariés qui contiennent soit X ou x dans la colonne I (copier l'ensemble des lignes qui contiennent ce X d'un coup serait génial) pour les coller dans le tableau B:I de récap salariés sans rien supprimer.
J'ai essayé de développer un code mais j'ai une erreur au niveau de la sélection du range.
J'ai une autre difficulté car mon tableau récap salariés contient déjà des données et il ne faut pas que sa écrase les données déjà existantes mais se coller des qu'une ligne est vide.

Voici mon essai le plus avancé :

Dim c As Range, sh As Worksheet
Set sh = Sheets("Recap salariés")
With Sheets("Liste salariés")
For Each c In Range(.[i2], .[i65536].End(xlUp))
If c = "x" Or c = "X" Then
Sheets("Recap salariés").Select
Rows("2:2").Select
c.EntireRow.Copy sh.Rows(sh.[A65536].End(xlUp).Row + 1)
End If
Next c
With Sheets("Liste salariés")
Application.ScreenUpdating = False

Merci d'avance,
Monkeyspace

 

[Robert]

Re : Copier Coller avec condition

Bonsoir MonkeySpace, bonsoir le forum,

En pièce jointe ton fichier modifié avec la macro ci-dessous qui utilise le filtre automatique :

Sub Macro1()
Dim ls As Object 'déclare la variable ls (onglet Liste Salariés)
Dim rs As Object 'déclare la variable rs (onglet Recap Salariés)
Dim dest As Range 'déclare la variable dest (cellule de DESTination)

Application.ScreenUpdating = False 'masque les rafraîchissements d'écran
Set ls = Sheets("Liste Salariés") 'définit l'onglet ls
Set rs = Sheets("Recap salariés") 'définit l'onglet rs
dl = ls.Cells(Application.Rows.Count, 1).End(xlUp).Row 'définit la dernière ligne éditée dl de la colonne 1 (=A) de l'onglet ls
Set pl = ls.Range("A2:A" & dl) 'définit la plage pl
If ls.FilterMode = False Then ls.Range("A1").AutoFilter 'si le filtre automatique n'est pas actif, active le filtre automatique
ls.Range("A1").AutoFilter field:=9, Criteria1:="x" 'filtre la colonne I avec "x" (ou "X") comme critère
Set dest = rs.Cells(Application.Rows.Count, 2).End(xlUp).Offset(1, 0) 'définit la cellule de destination dest
'copy les cellules visibles de la plage pl redimensionnée jusqu'à la colonne H dans la cellule des destination dest
pl.Resize(pl.Rows.Count, 8).SpecialCells(xlCellTypeVisible).Copy dest
ls.Range("A1").AutoFilter 'désactive le filtre automatique
Application.ScreenUpdating = True 'affiche les rafraîchissements d'écran
End Sub

Le fichier :

 

[Si...]

Re : Copier Coller avec condition

salut

Si... la macro est écrite dans la page de code de la feuille d'origine (Liste Salariés) compare

Sub Macro1()
  Set R = Range("A2", Cells(Rows.Count, 1).End(xlUp))
  [I1].AutoFilter field:=9, Criteria1:="x"
  R.Resize(R.Rows.Count, 8).SpecialCells(12).Copy Sheets("Recap salariés").[B2]
  [A1].AutoFilter
End Sub

et

Sub Macro2()
  Set R = Range("A2", Cells(Rows.Count, 1).End(xlUp))
  [I1].AutoFilter field:=9, Criteria1:="x"
  With Sheets("Recap salariés")
  R.Resize(R.Rows.Count, 8).SpecialCells(12).Copy .Range("B" & .Cells(Rows.Count, 2).End(xlUp).Row + 1)
  End With
  [A1].AutoFilter
End Sub

Avec la seconde macro, la plage est copiée à chaque lancement et tu te retrouves avec des lignes parasites.

 

[monkeyspace]

Re : Copier Coller avec condition

Merci Robert et Si...

Je vais essayer de rajouter un code les doublons car ce matin j'ai essayé plusieurs hypothèses et le risque de doublon est assez important.

Encore Merci

Monkeyspace