Copier et déplacer des valeurs à partir d'une condition

Bonsoir à tous,

Voila maintenant plusieurs heures que je cherche comment faire en VBA pour que le code analyse une plage de cellule et dès qu'il trouve une référence particulière (Yvonne dans mon exemple), il coupe et colle dans une autre colonne toutes les données qui étaient saisies en dessous de la référence (Yvonne).

Je vous ai joint un fichier avec une feuille avant et après retraitement pour que la compréhension soit plus facile.

Je suis partis sur une piste de variable du genre : Si tu trouve "Yvonne", alors tu coupes tout ce qu'il y a en dessous et tu colles dans une autre colonne.

Mais comment matérialiser tout ça en VBA ?

Merci pour votre précieuse aide !

Bonjour,

à tester,

Sub test_Transfert()
Set sh1 = Sheets("Avant")
Set sh2 = Sheets("Après")
sh2.Cells.ClearContents
début = 1 'les données commencent à la ligne 1 sur la feuille "Avant"
For i = 1 To sh1.Cells(Rows.Count, 1).End(xlUp).Row + 1
 If sh1.Cells(i, 1) = "" Then
  fin = i - 1
  derniereCol = sh2.Cells(1, Columns.Count).End(xlToLeft).Column + 1
  sh1.Range(Cells(début, 1).Address, Cells(fin, 1).Address).Copy sh2.Cells(1, derniereCol)
  début = i + 1
 End If
Next
End Sub

Bonjour SabV,

Merci pour ta réponse mais le code ne résous que partiellement mon problème.

1) Il décale la colonne A (l'entête et les données en dessous Raymond doivent rester dans la colonne A).

2) Je veux que la condition du "Couper coller" soit Yvonne et non l'espace qui sépare les données. J'ai donc modifié le code comme ceci :

Sub test_Transfert()
Set sh1 = Sheets("Avant")
Set sh2 = Sheets("Après")
sh2.Cells.ClearContents
début = 1 'les données commencent à la ligne 1 sur la feuille "Avant"
For i = 1 To sh1.Cells(Rows.Count, 1).End(xlUp).Row + 1
 If sh1.Cells(i, 1) = "Yvonne" Then ' <--------- J'ai renseigné ici Yvonne
  fin = i - 1
  derniereCol = sh2.Cells(1, Columns.Count).End(xlToLeft).Column + 1
  sh1.Range(Cells(début, 1).Address, Cells(fin, 1).Address).Copy sh2.Cells(1, derniereCol)
  début = i + 1
 End If
Next
End Sub

Mais ça n'a pas fonctionné...

As-tu une idée d'où peut venir le problème ? Merci !

Bonjour,

à tester,

Sub test_Transfert()
Set sh1 = Sheets("Avant")
Set sh2 = Sheets("Après")
sh2.Cells.ClearContents
début = 1 'les données commencent à la ligne 1 sur la feuille "Avant"
derniereCol = 1
For i = 1 To sh1.Cells(Rows.Count, 1).End(xlUp).Row + 1
 If sh1.Cells(i, 1) = "" Then
  fin = i - 1
  sh1.Range(Cells(début, 1).Address, Cells(fin, 1).Address).Copy sh2.Cells(1, derniereCol)
  derniereCol = sh2.Cells(1, Columns.Count).End(xlToLeft).Column + 2
  début = i + 1
 End If
Next
End Sub

SabV,

Merci encore pour ta réponse !

Je rencontre encore un petit problème avec la plage de cellule à déplacer à droite.

En fait, il ne faut pas que le critère soit de (Rows.Count, 1).End(xlUp).Row + 1 mais vraiment de 1 à "Yvonne".

Car en l'espèce, j'ai laissé un espace entre la derniere "Piste 7" relative à Raymond et "Yvonne" alors que sur mon fichier réel, je n'ai pas d'espace

Dès qu'Excel voit "Yvonne", il faudrait décaler dans une colonne à droite les cellules de Yvonne à la fin de la plage (ici cellule 20).

Merci infiniment et bon week-end !

Riri

pourriez-vous joindre un fichier montrant les vrai données avant et après ?