probleme boucle

[lufy50]

Bonsoir à tous,

Voila j'ai un probleme avec la macro si dessus :

Sub transfert()

Sheets("mediaire").Select
ActiveCell.SpecialCells(xlLastCell).Select
Range(Selection, Cells(1)).Select

For Each rw In Selection.Rows

ligne = rw.Row

If rw.Cells(ligne, 1) <> "" Then

rw.Copy Destination:=Worksheets(CStr(Sheets("mediaire").Cells(ligne, 25))).Cells(ligne, 1).EntireRow

End If

Next rw

End Sub

Elle ne s'execute que sur les 5 premieres lignes puis ne transfere plus les donnees.

J'espere que vous pourrez (encore !) me donner un coup de main.

Bonne soiree.

Lucy

 

[Compte Supprimé 979]

Re : probleme boucle

Salut Lufy50,

Essaye plutôt ce code ci

Sub transfert()
  Dim DerLig As Long, Rw As Range
  Sheets("mediaire").Select
  DerLig = Range("A" & Rows.Count).End(xlUp).Row
  For Each Rw In Range("A1:A" & DerLig)
    If Rw.Value <> "" Then
      Rw.Copy Destination:=Worksheets(CStr(Sheets("mediaire").Cells(Rw.Row, 25))).Cells(Rw.Row, 1).EntireRow
    End If
  Next Rw
End Sub

A+

 

[lufy50]

Re : probleme boucle

Merci , ca marche bien, sauf ca me copie la valeur de la colonne 1 sur toute la ligne alors que je veut juste qu'il me recopie la ligne.
Je vais bosser un peu dessus.

Merci et bonne soirée.