Copie de valeur selon certaines conditions

Fermé

HEMIYELY Messages postés 61 Date d'inscription mercredi 10 mai 2017 Statut Membre Dernière intervention 25 janvier 2022 - 14 nov. 2018 à 16:43
fabien25000 Messages postés 673 Date d'inscription mercredi 5 octobre 2016 Statut Membre Dernière intervention 28 juillet 2022 - 23 nov. 2018 à 17:11

Bonjour,
Je vous présente mon problème avec mon fichier pour être le plus explicite possible :
https://mon-partage.fr/f/TzVdgZgR/

- Dans la feuille "StockDyn" j'ai un tableau (B42:J94). Ce tableau contient des formules. Par l’intermédiaire d'une macro Copier/Coller, je souhaite fixer la valeur de certaines cellules si elles sont inférieures ou égales à une valeur.

- La première colonne de ce tableau fait référence à une date. Si cette date est égale ou inférieure à la date actuelle (cellule D40 toujours de la feuille "StockDyn") je souhaite recopier les lignes (sans les formules juste la valeur). Je souhaite ensuite coller les lignes au même endroit où elles ont été copiées.

- Par exemple, mon tableau commence à la date 30/10/2018. Nous sommes la semaine 14/11/2018.

- Je souhaite copier les valeurs des lignes contenant les dates antérieurs ou égale au 14/11/2018 et coller la valeur contenue dans ces cellules toujours sur la même plage (B43:J45).

Et ainsi de suite. Copier et coller les lignes si la date est inférieure à la date actuelle.

Ma demande est peut-être un peu tordue mais cela me permet de fixer les valeurs des lignes antérieures à la date actuelle et de continuer à avoir des formules pour calculer les valeurs des lignes postérieures à la date actuelle.

Je vous remercie par avance pour vos réponses.

Cordialement,

A voir également:

Copie de valeur selon certaines conditions
Copie cachée - Guide
Copie écran samsung - Guide
Super copie - Télécharger - Gestion de fichiers
Copie disque dur - Guide
Copie rapide - Télécharger - Gestion de fichiers

1 réponse

Réponse 1 / 1

fabien25000 Messages postés 673 Date d'inscription mercredi 5 octobre 2016 Statut Membre Dernière intervention 28 juillet 2022 59
Modifié le 14 nov. 2018 à 17:56

Bonjour,

un code qui devrait fonctionner, je l'ai mis sur open pensant que c'est le meilleur évènement pour cette tâche... Evidemment si on bosse dessus à miniut et qu'on change de date le taf ne se fait pas :

Private Sub Workbook_Open()
Dim derlig, i, j As Long
    derlig = Worksheets("StocksDyn").Range("A" & Rows.Count).End(xlUp).Row
    
    For i = 40 To derlig
        If Worksheets("StocksDyn").Range("A" & i) < Worksheets("StocksDyn").Range("D40") Then
            For j = 1 To 10
                Worksheets("StocksDyn").Range(Chr(64 + j) & i).Value = Worksheets("StocksDyn").Range(Chr(64 + j) & i).Value
            Next j
        End If
    Next i
End Sub

HEMIYELY Messages postés 61 Date d'inscription mercredi 10 mai 2017 Statut Membre Dernière intervention 25 janvier 2022
14 nov. 2018 à 18:41

Merci beaucoup pour votre réponse.
Il y a juste un détail qui me dérange.
Lorsque cette macro s'applique, la cellule D40 contenant la formule =AUJOURDUI() est modifiée pour mettre la date sans la formule. Je souhaite garder la formule =AUJOURDUI dans cette cellule.
Y a t-il une solution pour ce problème ?

Encore merci
Cordialement

fabien25000 Messages postés 673 Date d'inscription mercredi 5 octobre 2016 Statut Membre Dernière intervention 28 juillet 2022 59
Modifié le 14 nov. 2018 à 21:21

oui il faut remplacer

    For i = 40 To derlig
        If Worksheets("StocksDyn").Range("A" & i) < Worksheets("StocksDyn").Range("D40") Then
            For j = 1 To 10
                Worksheets("StocksDyn").Range(Chr(64 + j) & i).Value = Worksheets("StocksDyn").Range(Chr(64 + j) & i).Value
            Next j
        End If
    Next i

par :

    For i = 43 To derlig
        If Worksheets("StocksDyn").Range("A" & i) < Worksheets("StocksDyn").Range("D40") And Worksheets("StocksDyn").Range("A" & i) <> "" Then
            For j = 1 To 10
                Worksheets("StocksDyn").Range(Chr(64 + j) & i).Value = Worksheets("StocksDyn").Range(Chr(64 + j) & i).Value
            Next j
        End If
    Next i

j'avais mis 40 au pif pensant verifier et corriger mais j'ai zappé désolé

edit j'en ai profité pour traiter "si vide" qu'excel interprète comme antérieur à aujourd'hui

HEMIYELY Messages postés 61 Date d'inscription mercredi 10 mai 2017 Statut Membre Dernière intervention 25 janvier 2022
23 nov. 2018 à 13:41

Merci pour le temps que vous avez consacrer pour résoudre mon problème.

J'aimerai ajouter une nouvelle condition pour rendre mon fichier plus automatique.

Pour le moment avec cette macro je copie et coller les valeurs si elles sont antérieurs à la date actuelle.
J'aimerai avoir une option qui me permettrait de revenir en arrière et de remettre ma formule.

Est-ce qu'il y aurait une solution?

Merci encore pour votre réponse

Cordialement

fabien25000 Messages postés 673 Date d'inscription mercredi 5 octobre 2016 Statut Membre Dernière intervention 28 juillet 2022 59
23 nov. 2018 à 14:34

Bonjour,
Le plus simple à mon avis est de demander la permissions avant de transformer les formules en valeurs :

Private Sub Workbook_Open()
Dim derlig, i, j As Long
Dim tmpMsgBox As Integer

    derlig = Worksheets("StocksDyn").Range("A" & Rows.Count).End(xlUp).Row
    
    For i = 43 To derlig
        If Worksheets("StocksDyn").Range("A" & i) < Worksheets("StocksDyn").Range("D40") And Worksheets("StocksDyn").Range("A" & i) <> "" Then
            tmpMsgBox = MsgBox("Une (ou plusieurs) date est antérieure à aujourd'hui." & vbCrLf & _
            "Voulez vous transformer les formules en valeurs fixes?", vbQuestion + vbYesNo)
            Exit For
        End If
    Next i
    
    If tmpMsgBox = vbYes Then
        For i = 43 To derlig
            If Worksheets("StocksDyn").Range("A" & i) < Worksheets("StocksDyn").Range("D40") And Worksheets("StocksDyn").Range("A" & i) <> "" Then
                    For j = 1 To 10
                        Worksheets("StocksDyn").Range(Chr(64 + j) & i).Value = Worksheets("StocksDyn").Range(Chr(64 + j) & i).Value
                    Next j
            End If
        Next i
    Else
        Exit Sub
    End If
    
End Sub

si ça ne va pas il faudra intervenir sur un autre événement pour ré-écrire les formules
Peut être déterminer sur quelles lignes et comment faire pour que la macro sur open ne refasse pas l'inverse à la prochaine ouverture...

HEMIYELY Messages postés 61 Date d'inscription mercredi 10 mai 2017 Statut Membre Dernière intervention 25 janvier 2022
23 nov. 2018 à 15:54

Ok, C'est mieux de créer un nouvel événement. Je voudrais ajouter ce nouvel événement à ma macro "RESET" de ma feuille "Farm ID".
Lorsque je "reset" tout mon fichier, je souhaiterai que les formules de ce tableau réapparaissent.

Discussions similaires

lien copié

Problème de restrictions

Comment retrouver des lien copier sur sont téléphone

Formule Excel : "SI" une cellule contient un mot, alors ?