Discussion :

[touffoo]

Bonjour à tous,
débutant sous excel/VBA je viens chercher vos conseils d'experts pour résoudre un de mes problème.
Mes recherches jusque là n'ont pas été très fructueuses du fait que j'ai du mal à mettre un nom sur ce que je veux.

Tous les ans dans le cadre de la surveillance des plages par les sapeurs pompiers j'effectue la saisie journalière de l'activité
des 17 postes de secours en vue d'en faire une archive et d'exploiter statistiquement les résultats.
Soit 17 postes de secours avec 17 types de soins possibles sur une période de 4 mois.

Ci joint un exemple :
BRQ .xls

Jusqu'à présent j'attribuais une feuille par jour pour la saisie et un cumul en fin de mois par fichier. très fastidieux !!!!

Je souhaiterais pouvoir avoir une feuille unique nommée BRQ destinée à la fois à la saisie/enregistrement des données par jour et l'affichage/modification de données antérieures ( les données enregistrees par jour poste et type de soins seraient une feuille DATA exploitable par la suite).

merci pour votre attention, dans l'attente de vos réponses.

[XLRATOR]

Bonsoir,
Je reposte ton classeur, auquel j'ai insérer un bouton d'ajout au journal dont le code est le suivant:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
Dim rng As Range
For Each rng In Range("Matrice2").Cells
If rng.Value <> "" Then
Sheets(1).Range("A65365").End(xlUp).Offset(1, 0).Value = Date
Sheets(1).Range("B65365").End(xlUp).Offset(1, 0).Value = Cells(4, rng.Column).Value
Sheets(1).Range("C65365").End(xlUp).Offset(1, 0).Value = Cells(rng.Row, 1).Value
End If
Next
MsgBox "Sauvegarde términée", vbInformation

BRQ.xls

Et le tour est joué !

Cordialement
Karim.a

[XLRATOR]

Si tu veux sauvegarder le nombre de cas dans une colonne que tu appelerais Par Exemple "Qté" dans ce cas:

1-Tu metterais dans la cellule D1 de la feuille DATA = "Qté" ou "Quantité" ou ce que tu veux.
2- En suite Ajouter ce bout de code au bouton

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

Sheets(1).Range("D65365").End(xlUp).Offset(1, 0).Value = rng.Value

Juste en dessous de la ligne 6 de mon code ci-dessus.

Bon courage.
Karim

[touffoo]

bonsoir karim,
merci pour ta réponse

j'ai testé ta correction mais le bouton ne semble pas actif.
j'ai essayé d aller bidouiller dans l'editor mais sans succes.
je t'avoue que j'ai pas tout compris dans les lignes.

j'ai épuré mon fichier pour qu'il soit plus simple en gros il y a la date du jour,
les noms des différents postes en haut, les différents types de soins sur la colonne de gauche.

si tu as l'occasion d'y jeter un oeil, en fait quand j'ouvre le fichier je souhaiterais faire la saisie et valider à la date du jour (meme si les celulles sont vides), et pouvoir aussi en modifiant la date (en cliquant sur la date d'un petit tableau mensuel) afficher toutes les valeurs enregistrées(voir les modifier).
merci encore

[XLRATOR]

Rebonsoir,
Avec la nouvelle disposition de ton tableau, le code du bouton devient ce qui suit:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
Dim rng As Range
For Each rng In Range("Matrice").Cells
If rng.Value <> "" Then
 
Select Case Cells(rng.Row, 1).Value
Case "SSR"
Sheets(1).Range("A65365").End(xlUp).Offset(1, 0).Value = Date
Sheets(1).Range("B65365").End(xlUp).Offset(1, 0).Value = Cells(1, rng.Column).Value
Sheets(1).Range("C65365").End(xlUp).Offset(1, 0).Value = rng.Value
Sheets(1).Range("D65365").End(xlUp).Offset(1, 0).Value = 0
Sheets(1).Range("E65365").End(xlUp).Offset(1, 0).Value = 0
Sheets(1).Range("F65365").End(xlUp).Offset(1, 0).Value = 0
Case "SM"
Sheets(1).Range("A65365").End(xlUp).Offset(1, 0).Value = Date
Sheets(1).Range("B65365").End(xlUp).Offset(1, 0).Value = Cells(1, rng.Column).Value
Sheets(1).Range("C65365").End(xlUp).Offset(1, 0).Value = 0
Sheets(1).Range("D65365").End(xlUp).Offset(1, 0).Value = rng.Value
Sheets(1).Range("E65365").End(xlUp).Offset(1, 0).Value = 0
Sheets(1).Range("F65365").End(xlUp).Offset(1, 0).Value = 0
 
Case "SAR"
Sheets(1).Range("A65365").End(xlUp).Offset(1, 0).Value = Date
Sheets(1).Range("B65365").End(xlUp).Offset(1, 0).Value = Cells(1, rng.Column).Value
Sheets(1).Range("C65365").End(xlUp).Offset(1, 0).Value = 0
Sheets(1).Range("D65365").End(xlUp).Offset(1, 0).Value = 0
Sheets(1).Range("E65365").End(xlUp).Offset(1, 0).Value = rng.Value
Sheets(1).Range("F65365").End(xlUp).Offset(1, 0).Value = 0
 
Case "REF"
Sheets(1).Range("A65365").End(xlUp).Offset(1, 0).Value = Date
Sheets(1).Range("B65365").End(xlUp).Offset(1, 0).Value = Cells(1, rng.Column).Value
Sheets(1).Range("C65365").End(xlUp).Offset(1, 0).Value = 0
Sheets(1).Range("D65365").End(xlUp).Offset(1, 0).Value = 0
Sheets(1).Range("E65365").End(xlUp).Offset(1, 0).Value = 0
Sheets(1).Range("F65365").End(xlUp).Offset(1, 0).Value = rng.Value
End Select
 
End If
Next
 
MsgBox "Sauvegarde términée", vbInformation

Voici ton fichier le code y est inclus.
Copy of BRQ.xls

Cordialement.
Karim.

[touffoo]

je suis désolé je dois faire quelque chose de travers quand j'ouvre le fichier impossible de cliquer sur le bouton.
merci en tout cas