Boucle

[Patricia]

Bonjour,

J'ai une macro avec des conditions et notamment une boucle mais au bout de 15 fois la boucle arrête alors qu'il y a encore des données à prendre.

je pense qu'il faut mettre un compteur mais je ne sais pas à quel niveau - j'ai fais des essais mais ca me fonctionne pas ...

quelqu'un peut-il m'aider !!! je vous joins le fichier test

J'ai essayé quelques solutions proposées mais ca ne fonctionne pas

Merci d'avance

Patricia

 

[FDI]

J'ai testé ceci qui semble convenir.

CDt, FDI

Sub Tri_Travel() 'attention il y a un problème de compteur à voir

Dim DernLigne As Long

Dim LigneCible As Long
Dim LigneTotal As Long
Dim Counter As Long


Windows("Test.xls").Activate
Sheets("Form2").Select
Range("A22").Select
Sheets("Form2").Copy Before:=Sheets(2)
Sheets("Form2 (2)").Select
Sheets("Form2 (2)").Name = "Recap"

DernLigne = Sheets("Travel").Range("a65536").End(xlUp).Row ' numéro dernière ligne de la feuille 1 de BDactivite1
LigneCible = 22

For Each cell In Workbooks("Test.xls").Sheets("Travel").Range("h2:h" & DernLigne)
If cell.Value = Workbooks("Test.xls").Sheets("Travel").Range("j1").Value Then
Workbooks("Test.xls").Sheets("Recap").Range("A" & LigneCible).Value = (Workbooks("Test.xls").Sheets("Travel").Range("B" & cell.Row).Value)
Workbooks("Test.xls").Sheets("Recap").Range("B" & LigneCible).Value = (Workbooks("Test.xls").Sheets("Travel").Range("C" & cell.Row).Value)
Workbooks("Test.xls").Sheets("Recap").Range("C" & LigneCible).Value = (Workbooks("Test.xls").Sheets("Travel").Range("D" & cell.Row).Value)
Workbooks("Test.xls").Sheets("Recap").Range("D" & LigneCible).Value = (Workbooks("Test.xls").Sheets("Travel").Range("A" & cell.Row).Value)
Workbooks("Test.xls").Sheets("Recap").Range("E" & LigneCible).Value = (Workbooks("Test.xls").Sheets("Travel").Range("E" & cell.Row).Value)
Workbooks("Test.xls").Sheets("Recap").Range("F" & LigneCible).Value = (Workbooks("Test.xls").Sheets("Travel").Range("F" & cell.Row).Value)
Workbooks("Test.xls").Sheets("Recap").Range("G" & LigneCible).Value = (Workbooks("Test.xls").Sheets("Travel").Range("G" & cell.Row).Value)

LigneCible = LigneCible + 1
If LigneCible >= 26 Then
Workbooks("Test.xls").Sheets("Recap").Rows(LigneCible).Insert

Counter = 100
End If
End If

Next
LigneTotal = Workbooks("Test.xls").Sheets("Recap").Range("b65536").End(xlUp).Row
FormuleTotal = "=sum(e22:e" & LigneTotal - 1 & ")"
Workbooks("Test.xls").Sheets("Recap").Range("e" & LigneTotal).Value = FormuleTotal


End Sub

 

[john]

Voilà ton ficher modifié, fallait juste mettre une petite condition.

bon dimanche.

John

 

[Patricia]

Juste pour dire merci à tous ceux qui ont pu m'aider, grâce à vous j'ai pu terminé mon programme ... il fonctionne c'est vraiment super ...

Merci à ceux qui ont créé ce site et à ceux qui l'anime, car les expériences des uns et des autres sont très enrichissantes....

Merci encore Patricia