Autres Afficher une date dans plusieurs colonne via UserForm

Christian0258

XLDnaute Accro
Bonjour à tout le forum,

Je souhaiterais votre aide, pour afficher la date choisi via USF, dans plusieurs colonnes discontinues.
Actuellement la date est validée dans la première colonne et je n'arrive pas à adapter le code pour que cette date soit inscrite dans les colonnes G,K,Q,U,Y et AD.
Voir fichier...
Merci pour le temps que vous voudrez bien vouloir m'accorder.
Bien à vous,
Christian
 

Pièces jointes

  • Mettre date dans plusieurs colonne .xlsm
    94.3 KB · Affichages: 31

jmfmarques

XLDnaute Accro
Bonjour
1) si la même date doit être saisie dans plusieurs colonnes de la même ligne, il suffit d'une formule Excel dans les "autres" colonnes, non ?
2) Une même date dans plusieurs colonnes met sans le moindre doute en exergue une faiblesse de conception. Il devrait n'y avoir qu'une seule date dans une colonne ad-hoc, valable pour toutes les données d'une même ligne.

EDIT : enfin, quoi --->>
concevoir ainsi :
PETIT DEJEUNERDEJEUNERDINER
datedatedate
01/01/2000
céréales
01/01/2000
ragout
01/01/2000
soupe
est très nettement à reconsidérer au profit de :
PETIT DEJEUNERDEJEUNERDINER
date
01/01/2000
céréalesragoutsoupe
 
Dernière édition:

JM27

XLDnaute Barbatruc
bonjour
par exemple pour la colonne G
En reprenant ta macro ( qui n'est pas optimisée)
ActiveCell.Offset(0, 6).Value = CDate(LabelDate)
je te laisses le soin de faire les autres.

et dans un second temps Pour la Ambrée
A toi de faire la suite
On peut encore optimiser

VB:
Private Sub BtnAjout_Click()
    Dim Derligne As Long
    With Sheets("STOCK")
        Derligne = .Range("A2").End(xlDown).Row + 1
        .Cells(Derligne, 1) = CDate(LabelDate)
        .Cells(Derligne, 2) = Ambrée75
        .Cells(Derligne, 3) = Ambrée33
        .Cells(Derligne, 4) = Ambrée15
        .Cells(Derligne, 5) = Ambrée20
        
      
    '    ActiveCell.Offset(0, 7).Value = Blanche75
    '    ActiveCell.Offset(0, 8).Value = Blanche33
    '
    '    ActiveCell.Offset(0, 11).Value = Blonde75
    '    ActiveCell.Offset(0, 12).Value = Blonde33
    '    ActiveCell.Offset(0, 13).Value = Blonde15
    '    ActiveCell.Offset(0, 14).Value = Blonde20
    '
    '    ActiveCell.Offset(0, 17).Value = Blanchesureau75
    '    ActiveCell.Offset(0, 18).Value = Blanchesureau33
    '
    '    ActiveCell.Offset(0, 21).Value = Dubble75
    '    ActiveCell.Offset(0, 22).Value = Dubble33
    '
    '    ActiveCell.Offset(0, 25).Value = Ipa75
    '    ActiveCell.Offset(0, 26).Value = Ipa33
    '    ActiveCell.Offset(0, 27).Value = Ipa15
    '
    '    ActiveCell.Offset(0, 30).Value = Seigle75
    '    ActiveCell.Offset(0, 31).Value = Seigle33
    '    ActiveCell.Offset(0, 32).Value = Seigle15
    '    ActiveCell.Offset(0, 33).Value = Seigle20
    End With
End Sub
 
Dernière édition:

jmfmarques

XLDnaute Accro
Je pense que je vais te rappeler un dicton, selon lequel, "qui fait à sa tête, paye de son dos".
J'ignore en fait s'il s'agissait d'un vrai dicton et si, le cas échéant, il est encore en usage, mais me souviens très nettement que j'ai été élevé sur ces bases.
 

Christian0258

XLDnaute Accro
Re, jmfmarques, JM27

Merci JM27 pour ton aide, mais je n'arrive pas à insérer les codes, malgré tes explications claires (suis pas très doué en VBA).
Private Sub BtnAjout_Click()
Sheets("STOCK").Activate
Range("A2").Select
Selection.End(xlDown).Select
Selection.Offset(1, O).Select
.Cells(Derligne, 1) = CDate(LabelDate)
.Cells(Derligne, 2) = Ambrée75
.Cells(Derligne, 3) = Ambrée33
.Cells(Derligne, 4) = Ambrée15
.Cells(Derligne, 5) = Ambrée20
ActiveCell.Offset(0, 1).Value = Ambrée75
ActiveCell.Offset(0, 2).Value = Ambrée33
ActiveCell.Offset(0, 3).Value = Ambrée15
ActiveCell.Offset(0, 4).Value = Ambrée20
'et ainsi de suite, c'est ça ??? je suis un peu dérouté par les n° Cells et Active

.Cells(Derligne, 6) = CDate(LabelDate)
.Cells(Derligne, 7) = Blanche75
.Cells(Derligne, 8) = Blanche33
ActiveCell.Offset(0, 6).Value = CDate(LabelDate)
ActiveCell.Offset(0, 7).Value = Blanche75
ActiveCell.Offset(0, 8).Value = Blanche33

ActiveCell.Offset(0, 10).Value = CDate(LabelDate)
ActiveCell.Offset(0, 11).Value = Blonde75
ActiveCell.Offset(0, 12).Value = Blonde33
ActiveCell.Offset(0, 13).Value = Blonde15
ActiveCell.Offset(0, 14).Value = Blonde20

ActiveCell.Offset(0, 16).Value = CDate(LabelDate)
ActiveCell.Offset(0, 17).Value = Blanchesureau75
ActiveCell.Offset(0, 18).Value = Blanchesureau33

ActiveCell.Offset(0, 20).Value = CDate(LabelDate)
ActiveCell.Offset(0, 21).Value = Dubble75
ActiveCell.Offset(0, 22).Value = Dubble33

ActiveCell.Offset(0, 24).Value = CDate(LabelDate)
ActiveCell.Offset(0, 25).Value = Ipa75
ActiveCell.Offset(0, 26).Value = Ipa33
ActiveCell.Offset(0, 27).Value = Ipa15

ActiveCell.Offset(0, 29).Value = CDate(LabelDate)
ActiveCell.Offset(0, 30).Value = Seigle75
ActiveCell.Offset(0, 31).Value = Seigle33
ActiveCell.Offset(0, 32).Value = Seigle15
ActiveCell.Offset(0, 33).Value = Seigle20
Call copierladate

End Sub[/CODE]

à te lire,
Merci,
Christian
 

JM27

XLDnaute Barbatruc
Non tu vires tout les lignes avec activecell.offset

et tu les remplaces par exemple ( 5 étant la colonne E )
Et DerLigne étant la ligne de destination ( dernière ligne documentée+1) donc première ligne vide


VB:
Private Sub BtnAjout_Click()
    Dim Derligne As Long
    With Sheets("STOCK")
        Derligne = .Range("A2").End(xlDown).Row + 1
        .Cells(Derligne, 1) = CDate(LabelDate)
        .Cells(Derligne, 2) = Ambrée75
        .Cells(Derligne, 3) = Ambrée33
        .Cells(Derligne, 4) = Ambrée15
        .Cells(Derligne, 5) = Ambrée20
        .Cells(Derligne, 7) = = CDate(LabelDate)
        .Cells(Derligne, 8) = Blanche75
        .Cells(Derligne, 9) = Blanche33
       
        'Etc...

    End With
End Sub
 

mapomme

XLDnaute Barbatruc
Supporter XLD
Bonjour @Christian0258 :),

Je souscrit à ce qu'a dit jmfmarques. La structure de tes données ne va pas permettre une écriture facile du code tout en s'adaptant automatiquement à la taille des données.

@jmfmarques (surtout pour te saluer ;) )
"qui fait à sa tête, paye de son dos"
Je ne connaissais pas mais c'est souvent vrai.

Il faut néanmoins ne pas décourager à réinventer le monde, à encourager la sortie des sentiers battus, à ne pas toujours écouter et suivre les préceptes de nos anciens. Sinon bien des idées reçues et croyances auraient encore cours (et dire qu'il y a quelques temps, les gens croyaient que la terre été ronde et que l'homme était apparu par évolution en descendant du singe et des arbres o_O:p)
Inventer de nouvelles choses, c'est souvent avoir bien compris les raisonnements faux ou incomplets en cours, avoir trouvé une faille et par imagination avoir entrevu de nouvelle possibilités. Pour cela, on a souvent fait comme on nous a dit de faire, puis, pris son envol.

Attention cependant! Un autre proverbe "Les conseillers ne sont pas les payeurs". Se rappeler cette maxime, en ces temps où le Net déborde de conseils futiles, hurluberlus et dangereux.

Enfin, dans le cas qui nous concerne, ton conseil serait bon a suivre.

Bon, je retourne dans ma tanière pour me confiner...
 
Dernière édition:

JM27

XLDnaute Barbatruc
Re
voila comme moi je l'aurais réalisé
Une seule date
la somme en haut pour ne pas limiter le nb de saisies.
Sachant que je ne détiens pas la vérité
 

Pièces jointes

  • Test jm.xlsm
    94.9 KB · Affichages: 8
Dernière édition:

mapomme

XLDnaute Barbatruc
Supporter XLD
Bonjour @JM27 :)

Sachant que je détiens pas la vérité
Qui donc la détient ? En tous cas, pas moi non plus :confused:. Et puis souvent, on découvre quelqu'un qui détient une vérité plus vraie que celle qu'on croyait détenir :p. A la rigueur, on détient une vérité qui semble convenir à soi, mais c'est rarement "LA vérité". Il y a même des vérités qui échappent à notre entendement. Restons humbles.
A+
 

Christian0258

XLDnaute Accro
Re, bonjour à tout le forum,

Je n'arrive pas à adapter la macro du dernier fichier (post13) de JM27, Jean-Marcel que je remercie à nouveau.
J'ai créé une nouvel USF, pour la feuille VENTES, mais je coince pour modifier les codes, trop compliqués pour moi.
Pourriez-vous m'aider à ce sujet ?.
Merci pour votre aide, si précieuse.
Voir fichier.

Bien amicalement,
Christian
 

Pièces jointes

  • Essai USF - Copie.xlsm
    295.9 KB · Affichages: 5

Discussions similaires