Boucle copie-colle ligne avec condition de valeur d'une cellule [Fermé]

- - Dernière réponse : mapatos
Messages postés
1
Date d'inscription
samedi 15 février 2014
Statut
Membre
Dernière intervention
15 février 2014
- 15 févr. 2014 à 17:14
Bonjour,

Je me suis mise à VBA il y a peu, et je galère à faire une macro qui copie colle une ligne en fonction de la valeur de sa cellule en colonne D.

En effet, je souhaite faire une macro qui teste la valeur des cellules d'une colonne (ici colonne D) et qui en fonction de la valeur de la cellule, colle dans une autre feuille la ligne contenant cette cellule :


Pour l'instant ma macro ne fonctionne pas :


Sub Renouvellement()
'macro qui permet de copier toutes les lignes de l 'onglet "BD" dont la valeur de la 'cellule en colonne D est 'inférieure ou égale à E24 (date du jour + un an)
'dans la feuille Contratsàrenouveler


Sheets("BD").Activate
'je me place dans la feuille base de données
Range("D9").Select
'je sélectionne la cellule D9

'Tant que la cellule selectionnée de la colonne D n'est pas vide répéter la boucle

While IsEmpty(ActiveCell) = False

'Si la cellule selectionnée a une valeur inférieure ou égale à la cellule E24 de la feuille Recherchecontratsparfournisseur alors

If ActiveCell.Value <= Sheets("Recherchecontratsparfournisseur").Range("E24") Then

'je copie la ligne de la cellule qui remplit le critère de valeur
ActiveCell.Row.Copy

'j'active la feuille Contratsàrenouveler
Sheets("Contratsàrenouveler").Select

'je me place sur la cellule A3
Range("A3").Select

'je colle ma cellule
ActiveSheet.Paste

'j'insére une ligne en A3 ce qui décale ma cellule copiée d'une ligne vers le bas pour copier la suivante
Rows("3:3").Select
Selection.Insert Shift:=xlDown

End If

Wend


End Sub


Est-ce que vous pourriez me conseiller dans ma démarche pour créer cette macro qui copie-colle des lignes en fonction de la valeur de la cellule de la colonne D ???

Si je n'ai pas été très claire, n'hésitez pas à me demander plus d'infos.
Je suis novice donc j'ai un peu du mal à expliquer ce que je souhaite faire

Merci d'avance
Valentine
Afficher la suite 

3 réponses

Messages postés
14784
Date d'inscription
dimanche 25 novembre 2007
Statut
Membre
Dernière intervention
12 octobre 2019
1176
0
Merci
Bonjour,

prevoir une raz sur l'onglet Contratsàrenouveler ou autre suivant ce que vous voulez faire de la liste cree.

Deux facons de faire:

'empilage inverse par decalage vers le bas
'suivant votre programmation de depart
Sub Renouvellement_Inv()
    Dim plage As Range, cel As Range

    Application.ScreenUpdating = False
    valcherch = Sheets("Recherchecontratsparfournisseur").Range("E24")
    With Worksheets("BD")
        derlig = .Range("D" & Rows.Count).End(xlUp).Row
        Set plage = .Range("D9:D" & derlig)
    End With
    
    For Each cel In plage
        If cel <= valcherch Then
            cel.EntireRow.Copy
            Worksheets("Contratsàrenouveler").Range("A3").Select
            Selection.Insert Shift:=xlDown
        End If
    Next cel
    Application.ScreenUpdating = True
End Sub


'empilage normal par ecriture vers le bas
Sub Renouvellement_Norm()
    Dim plage As Range, cel As Range
    'stop rafraichissement ecran
    Application.ScreenUpdating = False
    'valeur a chercher
    valcherch = Sheets("Recherchecontratsparfournisseur").Range("E24")
    With Worksheets("BD")
        'derniere cellule colonne D
        derlig = .Range("D" & Rows.Count).End(xlUp).Row
        'defintion plage a tester en memoire
        Set plage = .Range("D9:D" & derlig)
    End With
    
    derlig = 0
    With Worksheets("Contratsàrenouveler")
        'test plage
        For Each cel In plage
            If cel <= valcherch Then
                'premiere cellule vide apres derniere non vide colonne D
                derlig = .Range("D" & Rows.Count).End(xlUp).Row + 1
                'premier lancement
                If derlig = 2 Then
                    derlig = 9
                End If
                'copy ligne entiere
                cel.EntireRow.Copy .Range("A" & derlig)
            End If
        Next cel
    End With
    'rafraichissement ecran
    Application.ScreenUpdating = True
End Sub


Bon courage

A+
0
Merci
Bonjour

Je te remercie beaucoup !!! Ton code fonctionne très bien !

Valentine
Hulet14
Messages postés
1
Date d'inscription
vendredi 24 janvier 2014
Statut
Membre
Dernière intervention
24 janvier 2014
-
Bonjour,

Merci à vous deux car ce code ma bien servi pour ceux que je veux faire, le seul problème est que j'ai une erreur de compilation et il me dit : "erreur de compilation, attendu fin d'instruction", Et je ne comprend clairement pas pourquoi j'ai ca? si vous avez la moindre idée ca m'aiderait beaucoup.
Merci
f894009
Messages postés
14784
Date d'inscription
dimanche 25 novembre 2007
Statut
Membre
Dernière intervention
12 octobre 2019
1176 -
Bonjour,

Sur quelle ligne le programme est en erreur ???
Messages postés
1
Date d'inscription
samedi 15 février 2014
Statut
Membre
Dernière intervention
15 février 2014
0
Merci
bonjour,
j'ai un problème identique que je n'arrive pas à régler malgré l'utilisation de vos macro, voici ma demande :

->J'ai créé une condition : lorsque l'utilisateur sélectionne son nom
->dans
le menu déroulant, la colonne date se met automatiquement à jour.
Je voudrai, que lorsque l'utilisateur complète sur la même ligne la cellule remarque (colonne D), cela verrouille les colonnes A, B, C, D de la ligne.
Ainsi les autres utilisateurs ne pourront plus modifier la cellule et aussi, la date verrouillée ne se mettra plus à jour au redémarrage du fichier.

->Deuxième demande : je voudrai que lorsque la cellule "urgent" apparait
(j'ai créé une condition pour que cela apparaisse au bout de 15 jours lorsque la remarque n'est pas réalisée), que la ligne soit recopiée en feuille urgent.
Attention chaque feuille correspond à un mois de l'année et doit répondre également à cette condition.

Merci de votre aide.