Copier/coller cellules selon conditions

bonjour à tous,

je consulte régulièrement votre forum afin de construire des fichiers pour mon travail.

et j'ai réussi jusqu'à aujourd'hui à adapter les codes grâce à vos explications et solutions.

je tenais à vous en remercier.

il se trouve que je suis dans l'impasse avec le code ci-dessous.

je souhaiterais adapter ce code pour copier les cellules visibles de A à K (après action du filtre automatique) dans feuillet vrac et les coller dans un autre feuillet appelé a1. puis supprimer les données visibles dans vrac après que la copie soit effectuée.

le soucis est que je ne parviens qu'à copier la ligne entière.

et après plusieurs jours de recherche, je sèche totalement....

Sub choix_atelier()

Dim LastLig As Long

Dim cDest As Range

Application.ScreenUpdating = False

With ThisWorkbook

With .Worksheets("a1")

Set cDest = .Cells(.Rows.Count, "A").End(xlUp)(2)

End With

With .Worksheets("vrac")

.AutoFilterMode = False

LastLig = .Cells(.Rows.Count, "B").End(xlUp).Row

.Range("K3:K" & LastLig).AutoFilter field:=1, Criteria1:="1"

If .Range("k3:k" & LastLig).SpecialCells(xlCellTypeVisible).Count > 1 Then

With .Range("k4:k" & LastLig).SpecialCells(xlCellTypeVisible).EntireRow

.Copy cDest

.Delete

End With

End If

Set cDest = Nothing

.AutoFilterMode = False

End With

End With

End Sub

merci d'avance pour votre aide!

Bonjour emv,

Sans le fichier, ce n'est pas facile pour tester, mais il me semble qu'en modifiant :

If .Range("k3:k" & LastLig).SpecialCells(xlCellTypeVisible).Count > 1 Then
With .Range("k4:k" & LastLig).SpecialCells(xlCellTypeVisible).EntireRow

par

If .Range("k3:k" & LastLig).SpecialCells(xlCellTypeVisible).Count > 1 Then
With .Range("A4:k" & LastLig).SpecialCells(xlCellTypeVisible)

Cela devrait fonctionner... A tester.

merci beaucoup ! tout fonctionne et je m'aperçois de mon erreur...

bonne journée à vous.