Envoyer des données en fonction d'une équation

Bonjour à tous,

Je dois créer un code qui me permet de copier les lignes 6 jusqu'à la dernière ligne utilisée sur la feuille 1 (001 - Fichier récapitulatif) et ceci pour les feuilles 3 jusqu'à la dernière feuille du classeur.

Voici mon code :

Sub envoie_les_dates_sur_feuille_recap()

Dim i As Variant
Dim f As Variant
Dim num As Variant
Dim cond As Variant

For i = 3 To ActiveWorkbook.Sheets.Count Step 1

    Sheets(i).Select

        For f = 6 To ActiveSheet.Rows.Count Step 1

        'num et cond ok
        num = Sheets(i).Cells(f, 5) - Sheets("001 - Fichier r?capitulatif").Range("C1")
        cond = Sheets("001 - Fichier r?capitulatif").Range("F1")

            If num < cond Then
            'Partie suivante ok
            dernligne = Sheets("001 - Fichier r?capitulatif").Cells(Rows.Count, 1).End(xlUp).Row
            Sheets("Feuil1").Rows(7).Copy Destination:=Sheets("001 - Fichier r?capitulatif").Rows(dernligne + 1)
            Else
            End If

        Next f

Next i

End Sub

Je précise que mes équations de num et cond prennent en comptes des dates, mais d'après ce que j'ai compris, cela ne doit pas poser de problème.

Du coup, mon problème est que le code tourne dans le vide jusqu'à l'infini ..

J'ai donc essayé de séparer le code, j'ai testé :

Sub test()

Dim num As Variant
Dim cond As Variant
Dim f As Variant

        For f = 6 To ActiveSheet.Rows.Count Step 1

        'num et cond ok
        num = Sheets("Feuil1").Cells(f, 5) - Sheets("001 - Fichier r?capitulatif").Range("C1")
        cond = Sheets("001 - Fichier r?capitulatif").Range("F1")

            If num < cond Then
            'Partie suivante ok
            dernligne = Sheets("001 - Fichier r?capitulatif").Cells(Rows.Count, 1).End(xlUp).Row
            Sheets("Feuil1").Rows(f).Copy Destination:=Sheets("001 - Fichier r?capitulatif").Rows(dernligne + 1)
            Else
            End If

        Next f

End Sub

Mais quand j'exécute le code pas à pas, il n'arrive pas à sortir de la boucle f alors que dans mon test, la boucle devrait se répéter que 2 fois (pour 6 et pour 7) et ensuite terminé.

J'attend vos réponses avec impatience.

Slt,

essaie de corrigé le nom du fichier:

Sheets("001 - Fichier r?capitulatif")

par ca

Sheets("001 - Fichier récapitulatif")

et puis on verra

Sur mon code, le nom est bon, il s'est juste changé quand je l'ai copié sur le forum.

Du coup, j'ai continuer de chercher, et quand je fais ctrl+fin pour savoir quel est ma dernière ligne utilisée, il va dans la ligne 265, mais elle sont toutes vides à partir de la ligne 8. Pour m'en assurer, j'ai supprimé toutes les dernières lignes, soit de la ligne à la 1048576 mais rien à faire, il me dit toujours que j'ai des valeurs jusqu'en 265 ..

besoin de ton fichier!

Ci-joint le fichier.

Pour info, j'ai ajouté une boucle If afin de sortir de ma boucle For si une valeur est vide et ça fonctionne mais ça allonge le code et j'ai peur que la macro soit longue à exécuter (sachant que je risque d'avoir une centaine de feuilles et une trentaine de ligne à traiter).

De plus la macro "test" est la macro uniquement pour traiter la feuille et la macro "envoie des donner sur fichier recap" permet de faire la meme chose pour toutes les feuilles.

re,

ben ton code fonctionne bien, si num < cond tout est bon, je vois pas où est le problème!

Oui il fonctionne mais ce que je comprenais pas, c'est pourquoi il arrivait pas à sortir de la boucle for tout seul, mais oui du coup, c'est bon.

Pour ceux qui ont le même problème, voici le code à jour :

Sub envoie_les_dates_sur_feuille_recap()

Dim i As Variant
Dim f As Variant
Dim num As Variant
Dim cond As Variant

For i = 3 To ActiveWorkbook.Sheets.Count Step 1

    Sheets(i).Select

        For f = 6 To ActiveSheet.Rows.Count Step 1
        Range("C3") = f
        'num et cond ok
        num = Sheets("Feuil3").Cells(f, 5) - Sheets("001 - Fichier r?capitulatif").Range("C1")
        cond = Sheets("001 - Fichier r?capitulatif").Range("F1")
        Rows(f).Select

            If num < cond Then
            'Partie suivante ok
            dernligne = Sheets("001 - Fichier r?capitulatif").Cells(Rows.Count, 1).End(xlUp).Row

            Sheets("Feuil3").Rows(f).Copy Destination:=Sheets("001 - Fichier r?capitulatif").Rows(dernligne + 1)
            Else
            End If

            If Cells(f, 1) = "" Then
            Exit For
            Else
            End If

        Next f

Next i

End Sub

Merci en tous cas !

Rechercher des sujets similaires à "envoyer donnees fonction equation"