code vba - saisies données - Résolu

Question

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///



Configuration: Windows 7 / Internet Explorer 10.0

Gyrus · Answer

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+

benji71 · Answer

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///

benji71 · Answer

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

Gyrus · Answer

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

benji71 · Answer

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///

Code vba - saisies données -

5 réponses

Discussions similaires

Newsletters