Code vba - saisies données -

Résolu/Fermé

benji71 Messages postés 738 Date d'inscription samedi 22 mars 2008 Statut Membre Dernière intervention 4 janvier 2015 - 27 juil. 2013 à 12:54
benji71 Messages postés 738 Date d'inscription samedi 22 mars 2008 Statut Membre Dernière intervention 4 janvier 2015 - 27 juil. 2013 à 19:19

Bonjour à tous & toutes,

J'espère que vous allez bien. Toujours en phase d'apprentissage (perpétuelle?)
Je soumets à vos avis un fichier visant à trouver un code vba permettant la saisie de données d'une feuille à l'autre. à toute fin utilise, je joins le fichier : https://www.cjoint.com/?3GBm0ZxYPBT

L'objectif est d'encodé des données par date d'événement sur la « feuil!cal » qui après enregistrement vont se retrouver sur la « feuil!data ».

Pour réaliser ce fichier, je cherche un code vba permettant de sauvegarder les données de la « feuil!cal » sur la « feuil!data » avec une difficulté supplémentaire, c'est qu'il peut y avoir plusieurs événement pour une même date.

Par exemple le 01/10/2013 est la journée internationale de la personne âgée & la journée internationale de l'habitât. c'est pourquoi, j'ai mis sur la « feuil!data » trois colonnes (b,c,d).

Si l'un ou l'autre d'entre vous aurait la gentillesse de se pencher sur mon cas...

Deux dernières précisions :
(a) Je m'efforce de trouver des réponses notamment via :
https://didier-gonard.developpez.com/tutoriels/office/vba-qu-est-que-c-est/
et
https://www.excel-pratique.com/fr/vba/introduction.php

(b) Ma démarche vise à comprendre pour que plus tard, je puisse le faire par moi-même mais l'aide d'autres plus aguerris est parfois bien précieuse.

je vous souhaite une excellente après-midi.

Bien cdlmnt,

Berni///

A voir également:

Code vba - saisies données -
Code asci - Guide
Code puk bloqué - Guide
Code telephone oublié - Guide
Code blocks free - Télécharger - Langages
Code windows 10 - Guide

5 réponses

Réponse 1 / 5

Gyrus Messages postés 3334 Date d'inscription samedi 20 juillet 2013 Statut Membre Dernière intervention 9 décembre 2016 523
27 juil. 2013 à 13:26

Bonjour,

A tester

Sub Enregistrer()
Dim WsS As Worksheet, WsC As Worksheet
Dim LigneAjoutC As Long
Dim ColonneAjout As Integer
Dim D As Range
    Set WsS = Worksheets("cal")
    Set WsC = Worksheets("data")
    If IsDate(WsS.Range("X4").Value) Then
        Set D = WsC.Columns(1).Find(WsS.Range("X4").Value, , xlFormulas, xlWhole)
        If Not D Is Nothing Then
            ColonneAjout = WsC.Cells(D.Row, Columns.Count).End(xlToLeft).Column + 1
            WsC.Cells(D.Row, ColonneAjout) = WsS.Range("X6").Value
        Else
            LigneAjoutC = WsC.Range("A" & Rows.Count).End(xlUp).Row + 1
            WsC.Cells(LigneAjoutC, 1) = WsS.Range("X4").Value
            WsC.Cells(LigneAjoutC, 2) = WsS.Range("X6").Value
        End If
    End If
    Set WsS = Nothing: Set WsS = Nothing: Set D = Nothing
End Sub

A+

Réponse 2 / 5

benji71 Messages postés 738 Date d'inscription samedi 22 mars 2008 Statut Membre Dernière intervention 4 janvier 2015 23
27 juil. 2013 à 15:35

Bonjour gyrus,

un tout grand merci pour votre réponse.
j'ai testé et approuvé...ça marche vraiment bien... :-))
vous avez été plus vite que moi...mais je compte m'inspirer de ce que vous proposer.

si cela intéresse d'autre personne, je joins le fichier avec la macro : https://www.cjoint.com/?3GBpEBcggtx

petit "caprice" mais pensez-vous qu'il soit possible de faire en sorte qu'après avoir enregistrer l'événement, les espace prévu pour sur la feuil!cal puisse s'effacer, laissant la place pour un nouvel encodage ?

un tout grand merci à vous ou aux autres membre du forum.

bonne après-midi,

cdlmnt,

berni///

Réponse 3 / 5

benji71 Messages postés 738 Date d'inscription samedi 22 mars 2008 Statut Membre Dernière intervention 4 janvier 2015 23
27 juil. 2013 à 15:37

petit oubli, les cellules dont le contenu devrait être effacé après enregistrement sont les cellules x4 et x6.

merci.

Réponse 4 / 5

Gyrus Messages postés 3334 Date d'inscription samedi 20 juillet 2013 Statut Membre Dernière intervention 9 décembre 2016 523
27 juil. 2013 à 19:06

Celle-là, j'aurais parié que tu la trouverais tout seul... et j'aurais perdu !

Sub Enregistrer()
Dim WsS As Worksheet, WsC As Worksheet
Dim LigneAjoutC As Long
Dim ColonneAjout As Integer
Dim D As Range
    Set WsS = Worksheets("cal")
    Set WsC = Worksheets("data")
    If IsDate(WsS.Range("X4").Value) Then
        Set D = WsC.Columns(1).Find(WsS.Range("X4").Value, , xlFormulas, xlWhole)
        If Not D Is Nothing Then
            ColonneAjout = WsC.Cells(D.Row, Columns.Count).End(xlToLeft).Column + 1
            WsC.Cells(D.Row, ColonneAjout) = WsS.Range("X6").Value
        Else
            LigneAjoutC = WsC.Range("A" & Rows.Count).End(xlUp).Row + 1
            WsC.Cells(LigneAjoutC, 1) = WsS.Range("X4").Value
            WsC.Cells(LigneAjoutC, 2) = WsS.Range("X6").Value
        End If
        WsS.Range("X4").Value = ""
        WsS.Range("X6").Value = ""
    End If
    Set WsS = Nothing: Set WsS = Nothing: Set D = Nothing
End Sub

Vous n’avez pas trouvé la réponse que vous recherchez ?

Posez votre question

Réponse 5 / 5

benji71 Messages postés 738 Date d'inscription samedi 22 mars 2008 Statut Membre Dernière intervention 4 janvier 2015 23
27 juil. 2013 à 19:19

bonsoir gyrus,

"Celle-là, j'aurais parié que tu la trouverais tout seul... et j'aurais perdu !" pas certain ;-)

un tout grand merci à vous...voilà une macro qui va bine servir...

encore merci à vous,

tres cdlmnt,

berni///

Discussions similaires

Code de renvoi d'appel : Ooredo, Mobilis...

Acces à snapchat temporairement désactivé

Code Free Wifi Secure : comment en récupérer

Discussions similaires

Newsletters