Boucle trop longue

Bonjour,

voila j'expose mon souci:

j'ai creer une boucle qui prend la valeur de la colonne avec des conditions.

Cependant la boucle et beaucoup trop longue pour copié les valeurs des colonnes car il doit parcourir chaque ligne et je possede beaucoup de donnée a traiter.

Desoler pour le excel je ne peux pas le telecharger il est asssez volumineux. MERCI pour votre aide la communauté!

un petit fichier daide

=) =)

Sub tag()

'definition des variables
Dim I As Long
Dim J As Byte
Dim H As Long
Dim Lignefin As Long
Dim ice As Long
Dim otc As Long
Dim shift As Long

'on vide au préalable les données dans le tableau de restitution 
 Sheets("Feuil1").Range("Al4:Ar60000").ClearContents

'ligne sur laquelle on va commencer à coller les données
H = 4

'définit la dernière ligne sur laquelle il y aura des données à analyser
Sheets("Feuil1").Select
Range("A1048575").Select
    Selection.End(xlUp).Select

'lignefin sera égale à la valeur de la ligne de la cellule selectionnée
Lignefin = ActiveCell.Row

'Nom des valeur recherche
ice = (Sheets("Feuil1").Cells(2, 39).Value)
otc = (Sheets("Feuil1").Cells(2, 40).Value)
shaft = (Sheets("Feuil1").Cells(2, 41).Value)
 For I = 4 To Lignefin Step 1

'si la cellule contient la valeur il va en line1 sinon en line2 ou la boucle se poursuit.
       If Sheets("Feuil1").Cells(I, 33) = ice And Sheets("Feuil1").Cells(I, 36) = otc And Sheets("Feuil1").Cells(I, 34) > shaft And Sheets("Feuil1").Cells(I, 28) < 0.5 Then GoTo Line1 Else GoTo Line2

Line1:

With Sheets("Feuil1")
.Cells(H, 38).Value = .Cells(I, 1).Value
.Cells(H, 39).Value = .Cells(I, 4).Value
 .Cells(H, 40).Value = .Cells(I, 5).Value
.Cells(H, 41).Value = .Cells(I, 28).Value
.Cells(H, 42).Value = .Cells(I, 3).Value
.Cells(H, 43).Value = .Cells(I, 7).Value
.Cells(H, 44).Value = .Cells(I, 9).Value

H = H + 1

End With
Line2:

'la boucle se relance pour la recherche de
Next I

'retour sur la feuille conso et selection d'une ligne en haut de tableau
Sheets("Feuil1").Select
Cells(1, 47).Select

End Sub

Bonjour,

étant donné que tous se passe sur la Feuil1, j'ai commencé le code avec elle,

les variables I et H étant tous les deux = à 4, alors j''ai éliminé H

aussi la structure de If....Then étant la suivante nul besoin de GoTo Line1 Else GoTo Line2

If vrai then
 'action si vrai
Else
 'action si faux
End if

Sub tag()
'definition des variables
Dim I As Long
Dim Lignefin As Long
Dim ice As Long
Dim otc As Long
Dim shift As Long

With Sheets("Feuil1")

'on vide au préalable les données dans le tableau de restitution
 .Range("Al4:Ar60000").ClearContents

'définit la dernière ligne sur laquelle il y aura des données à analyser
 Lignefin = .Cells(Rows.Count, 1).End(xlUp).Row

'Nom des valeur recherche
 ice = .Cells(2, 39).Value
 otc = .Cells(2, 40).Value
 shaft = .Cells(2, 41).Value

 For I = 4 To Lignefin
 'si la condition est vrai on execute le transfert de valeur sinon la boucle se poursuit.
  If .Cells(I, 33) = ice And .Cells(I, 36) = otc And .Cells(I, 34) > shaft And .Cells(I, 28) < 0.5 Then
    .Cells(I, 38).Value = .Cells(I, 1).Value
    .Cells(I, 39).Value = .Cells(I, 4).Value
    .Cells(I, 40).Value = .Cells(I, 5).Value
    .Cells(I, 41).Value = .Cells(I, 28).Value
    .Cells(I, 42).Value = .Cells(I, 3).Value
    .Cells(I, 43).Value = .Cells(I, 7).Value
    .Cells(I, 44).Value = .Cells(I, 9).Value
  End If
 Next I  'la boucle se relance pour la recherche de
End With
'retour sur la feuille conso et selection d'une ligne en haut de tableau
Application.Goto Sheets("Feuil1").Cells(1, 47)
End Sub

Bonjour à tous

Un essai à tester. Te convient-il ?

Bye !

bonjour

la boucle te gêne, supprime-la !

avec une colonne de pointage (formule simple)

et ensuite un simple filtrage sur la colonne

tu peux, si tu veux vraiment, copier la zone ainsi filtrée et la copier ailleurs

et même enregistrer une macro qui fera le job à ta place, macro pas belle mais tu n'as aucune programmation à faire

Bonsoir les amis, merci pour votre aide vos codes marchent impeccable.

MERCI A VOUS !!!

Bonne soirée et à bientot.