Copier une donnée pour créer un historique

[Jerome]

Bonjour,

Je voulais savoir si c'était possible ou pas de faire en sorte qu'une donnée tapée dans une cellule ou deux, soit recopiée sur une autre feuille dans un tableau et à chaque fois qu'on entre une nouvelle donnée, celle ci soit recopiée dans le tableau mais dans la ligne d'en dessous ?

cela afin de créer un historique des données entrées.

Je ne pense pas que cela soit possible mais qui ne demande rien n'a rien...

Merci,

Jerome

 

[Michel_M]

Bonjour Jérome,

ci joint proposition

comme quoi...

Michel

 

[Jerome]

Merci beaucoup


Je vais essayer de l'adapter à mon fichier,

je vous tiens au courant.

Jerome

 

[Jerome]

J'ai modifié la macro pour valider les changements lorsque l'on tape sur une autre cellule (Validez) que celle ou l'on modifie la valeur sinon il me mettait à jour le tableau lorsque je cliquais sur la cellule pour la modifier :-/


J'aurais besoin d'un peu d'aide pour modifier le programme pour ajouter des cellules à copier,

j'ai créer deux autres programmes de test :

------------------------------------------------------------------

Sub test1()
Dim lig As Long

Worksheets("suivi").Activate

'numéro de la 1) ligne vide
lig = Columns(4).Find("", Range("D1"), , , xlByRows).Row

' attribue à la cellule située à la la ligne "n°lig" colonne D la valeur de A1
Cells(lig, 4) = Worksheets("saisie").Range("B1")
Cells(lig, 3) = Worksheets("saisie").Range("A1")
Range(Cells(lig, 3), Cells(lig, 4)).Borders.Weight = xlThin

End Sub

Sub test2()
Dim lig As Long

Worksheets("suivi").Activate

'numéro de la 1) ligne vide
lig = Columns(7).Find("", Range("G1"), , , xlByRows).Row

' attribue à la cellule située à la la ligne "n°lig" colonne D la valeur de A1
Cells(lig, 7) = Worksheets("saisie").Range("B4")
Cells(lig, 6) = Worksheets("saisie").Range("A4")
Range(Cells(lig, 6), Cells(lig, 7)).Borders.Weight = xlThin

End Sub

Sub test3()
Dim lig As Long

Worksheets("test").Activate

'numéro de la 1) ligne vide
lig = Columns(3).Find("", Range("C1"), , , xlByRows).Row

' attribue à la cellule située à la la ligne "n°lig" colonne D la valeur de A1
Cells(lig, 3) = Worksheets("saisie").Range("B4")
Cells(lig, 2) = Worksheets("saisie").Range("A4")
Range(Cells(lig, 2), Cells(lig, 3)).Borders.Weight = xlThin

End Sub

-----------------------------------------------------

Le probleme c'est que je ne comprends pas comment faire pour modifier celui ci :

------------------------------------------

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
' limite l'évenement selectionchange à la cellule D1
If Intersect(Target, Range("C1")) Is Nothing Then Exit Sub
If IsEmpty(Target) Then Exit Sub
test1
End Sub

-----------------------------------------------


Pour que lorsque je clique sur une cellule "Validez", c'est le tableau correspondant à cette cellule qui est mis à jour.


J'ai essayé de répéter 3 fois ce bout de programme en changeant les valeurs des cellules mais ça ne marche pas,

je pense que la solution serait un IF ELSE mais je ne sais pas comment la faire...

Merci,

Jerome

 

[Michel_M]

Re,

Je vois mal ce que tu veux faire. Si tu peux joindre un extrait de ton fichier ou mieux expliquer (je sais, ce n'est pas forcément évident)

A+
Michel

 

[Jerome]

Voilà le fichier,

En faites, j'aimerais faire la meme chose que ce que fais le fichier à l'origine (recopier dans une autre feuille sous forme de tableau une valeur tapée dans la 1ere) mais pour 3 valeurs sur la meme page et non plus une seule.

Sur ce fichier :

J'arrive à copier les cellules A1 et B1 de la feuille "saisie" dans les colonnes C et D de la feuille "suivi", en cliquant sur la cellule C1

le probleme c'est que je n'arrive pas à copier les cellules A4 et B4 de la feuille "saisie" dans les colonnes F et G de la feuille "suivi", en cliquant sur la cellule C4

et je n'arrive pas à copier les cellules A12 et B12 de la feuille "saisie" dans les colonnes B et C de la feuille "test", en cliquant sur la cellule C12

Comme je l'ai marqué plus haut, j'ai réussi à faire les sous-programmes pour qu'il copie les cellules, mais je ne comprends pas comment modifier le dernier sous programme pour qu'il sache que lorsque l'on clique sur la cellule C4, il doit exécuter le sous programme "test2" et lorsque l'on clique sur la cellule C12, il doit exécuter le sous programme "test3".


Je sais pas si c'est tres clair ce que je dis :-/

Si oui tant mieux sinon ça ne me dérangerait pas de réexpliquer ;-)


Merci,

Jerome

 

[Michel_M]

Okay, Jerome, je regarde çà cet aprèm... j'ai faim !
Michel

 

[@+Thierry]

Bonjour Michel_M (et bon app), Jérome, le Forum

Juste pour faire avancer le shmilblic pendant le déjeuner !!! lol

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Select Case Target.Address
Case "$C$1": Test1
Case "$C$4": Test2
Case "$C$12": Test3
End Select
End Sub

Mais il faudrait tout de même faire des tests sur les cellules à reporter dans les Macro Test1, 2 et 3, car sinon on va reporter du vide selon le cas...

Bon Appétit !
@+Thierry

 

[Jerome]

Merci pour votre aide à tous les deux,

J'ai essayé pour les tests en cas de cellules vides mais ça ne marche pas,

j'ai jamais fais de VB, alors j'ai un peu de mal.

Sinon lorsque l'on valide,

il affiche la page ou il y a le tableau qui a été modifié,

est ce qu'il existe une instruction pour qu'il revienne à la page de saisie tout seul ?

merci,

Jerome

 

[@+Thierry]

Re Bonjour Jérome, Michel (sacré casse croute ! lol)

Ben je ne sais pas, je peux te proposer ceci admettons :

Sub Test1()
Dim lig As Long
Dim WSSource As Worksheet, WSCible As Worksheet

With ThisWorkbook
Set WSSource = Worksheets("saisie")
Set WSCible = Worksheets("suivi")
End With

'Worksheets("suivi").Activate '<<<<<<<< INUTILE (à cause de ceci tu changes de page affichée)

lig = WSCible.Columns(4).Find("", WSCible.Range("D1"), , , xlByRows).Row

'Ici un test pour être sûr qu'au moins une cellule contient quelque chose sinon on sort
If Len(WSSource.Range("A1") & WSSource.Range("B1")) = 0 Then
MsgBox "Les Cellules Sources sont vides"
Exit Sub
End If

With WSCible
.Cells(lig, 4) = WSSource.Range("B1")
.Cells(lig, 3) = WSSource.Range("A1")
.Range(.Cells(lig, 3), .Cells(lig, 4)).Borders.Weight = xlThin
End With

End Sub

Bon Aprèm
@+Thierry

 

[Michel_M]

Re,

Ben voilà,voilà

Toujours à la bourre, le Père Michel...

Pour arriver à peu près à la m^me solution (je gérais les cellules vides en amont de test x)

A+
Michel

 

[Jerome]

Merci beaucoup,

j'ai simplement changé cette ligne :

If Len(WSSource.Range("A1") & WSSource.Range("B1")) = 0 Then

par celle ci :

If Len(WSSource.Range("B1")) = 0 Then

Parce que comme le contenu de la cellule A1 est une date et ça ne marchait pas,

et j'ai ajouté ça à la fin :

MsgBox "Données Enregistrées"

avant le End Sub pour etre sur que les données ont été enregistrées. ;-)


Si jamais il y a la possibilité de faire le test avec une date n'hésitez pas à m'en faire part,

sinon je vous remercie beaucoup pour votre aide à tous les deux,

Jerome

 

[@+Thierry]

Re Jérome, Michel

Et oui à la bourre le père Michel, c'est çà ou faire comme moi, manger un sandwich d'un main et le clavier de l'autre !! Pour le test en amont vu que Jérome parle de cellules à reporter différentes de la Target, je l'avais viré, mais on peut le remettre si rien ne doit se passer si la Cellule C1, C4 ou C12 sont vides.

Pour ta dernière question Jérome tu peux faire ceci :
If Not IsDate(WSSource.Range("A1")) Or Len(WSSource.Range("B1")) = 0 Then
MsgBox "Les Cellules Sources sont vides ou ne contiennent pas de date"
Exit Sub
End If

Bonne Fin d'Aprèm
@+Thierry

 

[Michel_M]

re à tous les 2

en ce qui concerne l'exclusion si une des cellules est vide voilà ce que j'avais écrit dans selection_change:

If Target.Address = "$C$1" Or Target.Address = "$C$4" Or Target.Address = "$C$12" Then
If Target.Offset(0, -2) = "" Or Target.Offset(0, -1) = "" Then
MsgBox "saisies incomplètes"
Exit Sub
End If
....instructions select case
End if

mais bôââfff !

Fais gaffe, Thierry, c'est mauvais de manger avec un sandwich tout en programmant, mon toubib m'a super-engueulé
Et comme c'est les vacances, le siestou est de rigueur !
;-)

Bonne soirée
Michel

 

[jerome]

Bonsoir,

ça marche bien maintenant, je vous remercie,

Je vais pouvoir modifier le tableau que j'avais commencé

(Au passage, c'est un carnet d'entretien pour 205, pour mon site web qui leur est consacré)

Encore merci,

jerome