Besoin d'aide pour améliorer un code vba

Version imprimable

Bien le bonjour ;)

Voila je suis entrain de faire un calendrier de réservation pour un camping pour la partie coter feuille de calcule pas de problème mais coter vba j'ai quelques soucis.

Mon calendrier vas de 2016 à 2050 la partie vba reprend des stats pour les mettres dans une autre feuille. J'arrive à le faire mais le problème est de 2016 a 2050 sa fait pas mal de ligne

Donc je cherche une facon de faire pour avoir de lignes

le code qui est juste sur deux ans

Code:

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
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
 
Dim CalendrierMois
Dim CalendrierAnnée
Dim NomFeuille
 
Private Sub Worksheet_Activate()
    If Range("D1") = "" Then
        ThisWorkbook.RefreshAll
    End If
 
End Sub
 
 
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    CalendrierMois = Range("H1").Value
    CalendrierAnnée = Range("D1").Value
    NomFeuille = "Stats"
    If CalendrierAnnée = "2017" Then
        If CalendrierMois = "Janvier" Then
            Worksheets(NomFeuille).[B3] = Range("AH16").Value
            Worksheets(NomFeuille).[C3] = Range("AI16").Value
            [AH19] = Worksheets(NomFeuille).Range("B15").Value
            [AI19] = Worksheets(NomFeuille).Range("C15").Value
        ElseIf CalendrierMois = "Février" Then
            Worksheets(NomFeuille).[B4] = Range("AH16").Value
            Worksheets(NomFeuille).[C4] = Range("AI16").Value
            [AH19] = Worksheets(NomFeuille).Range("B15").Value
            [AI19] = Worksheets(NomFeuille).Range("C15").Value
        ElseIf CalendrierMois = "Mars" Then
            Worksheets(NomFeuille).[B5] = Range("AH16").Value
            Worksheets(NomFeuille).[C5] = Range("AI16").Value
            [AH19] = Worksheets(NomFeuille).Range("B15").Value
            [AI19] = Worksheets(NomFeuille).Range("C15").Value
        ElseIf CalendrierMois = "Avril" Then
            Worksheets(NomFeuille).[B6] = Range("AH16").Value
            Worksheets(NomFeuille).[C6] = Range("AI16").Value
            [AH19] = Worksheets(NomFeuille).Range("B15").Value
            [AI19] = Worksheets(NomFeuille).Range("C15").Value
        ElseIf CalendrierMois = "Mai" Then
            Worksheets(NomFeuille).[B7] = Range("AH16").Value
            Worksheets(NomFeuille).[C7] = Range("AI16").Value
            [AH19] = Worksheets(NomFeuille).Range("B15").Value
            [AI19] = Worksheets(NomFeuille).Range("C15").Value
        ElseIf CalendrierMois = "Juin" Then
            Worksheets(NomFeuille).[B8] = Range("AH16").Value
            Worksheets(NomFeuille).[C8] = Range("AI16").Value
            [AH19] = Worksheets(NomFeuille).Range("B15").Value
            [AI19] = Worksheets(NomFeuille).Range("C15").Value
        ElseIf CalendrierMois = "Juillet" Then
            Worksheets(NomFeuille).[B9] = Range("AH16").Value
            Worksheets(NomFeuille).[C9] = Range("AI16").Value
            [AH19] = Worksheets(NomFeuille).Range("B15").Value
            [AI19] = Worksheets(NomFeuille).Range("C15").Value
        ElseIf CalendrierMois = "Août" Then
            Worksheets(NomFeuille).[B10] = Range("AH16").Value
            Worksheets(NomFeuille).[C10] = Range("AI16").Value
            [AH19] = Worksheets(NomFeuille).Range("B15").Value
            [AI19] = Worksheets(NomFeuille).Range("C15").Value
        ElseIf CalendrierMois = "Septembre" Then
            Worksheets(NomFeuille).[B11] = Range("AH16").Value
            Worksheets(NomFeuille).[C11] = Range("AI16").Value
            [AH19] = Worksheets(NomFeuille).Range("B15").Value
            [AI19] = Worksheets(NomFeuille).Range("C15").Value
        ElseIf CalendrierMois = "Octobre" Then
            Worksheets(NomFeuille).[B12] = Range("AH16").Value
            Worksheets(NomFeuille).[C12] = Range("AI16").Value
            [AH19] = Worksheets(NomFeuille).Range("B15").Value
            [AI19] = Worksheets(NomFeuille).Range("C15").Value
        ElseIf CalendrierMois = "Novembre" Then
            Worksheets(NomFeuille).[B13] = Range("AH16").Value
            Worksheets(NomFeuille).[C13] = Range("AI16").Value
            [AH19] = Worksheets(NomFeuille).Range("B15").Value
            [AI19] = Worksheets(NomFeuille).Range("C15").Value
        ElseIf CalendrierMois = "Décembre" Then
            Worksheets(NomFeuille).[B14] = Range("AH16").Value
            Worksheets(NomFeuille).[C14] = Range("AI16").Value
            [AH19] = Worksheets(NomFeuille).Range("B15").Value
            [AI19] = Worksheets(NomFeuille).Range("C15").Value
        End If
    End If
 
    If CalendrierAnnée = "2018" Then
        If CalendrierMois = "Janvier" Then
            Worksheets(NomFeuille).[D3] = Range("AH16").Value
            Worksheets(NomFeuille).[E3] = Range("AI16").Value
            [AH19] = Worksheets(NomFeuille).Range("D15").Value
            [AI19] = Worksheets(NomFeuille).Range("E15").Value
        ElseIf CalendrierMois = "Février" Then
            Worksheets(NomFeuille).[D4] = Range("AH16").Value
            Worksheets(NomFeuille).[E4] = Range("AI16").Value
            [AH19] = Worksheets(NomFeuille).Range("D15").Value
            [AI19] = Worksheets(NomFeuille).Range("E15").Value
        ElseIf CalendrierMois = "Mars" Then
            Worksheets(NomFeuille).[5] = Range("AH16").Value
            Worksheets(NomFeuille).[E5] = Range("AI16").Value
            [AH19] = Worksheets(NomFeuille).Range("D15").Value
            [AI19] = Worksheets(NomFeuille).Range("E15").Value
        ElseIf CalendrierMois = "Avril" Then
            Worksheets(NomFeuille).[D] = Range("AH16").Value
            Worksheets(NomFeuille).[E6] = Range("AI16").Value
            [AH19] = Worksheets(NomFeuille).Range("D15").Value
            [AI19] = Worksheets(NomFeuille).Range("E15").Value
        ElseIf CalendrierMois = "Mai" Then
            Worksheets(NomFeuille).[D7] = Range("AH16").Value
            Worksheets(NomFeuille).[E7] = Range("AI16").Value
            [AH19] = Worksheets(NomFeuille).Range("D15").Value
            [AI19] = Worksheets(NomFeuille).Range("E15").Value
        ElseIf CalendrierMois = "Juin" Then
            Worksheets(NomFeuille).[D8] = Range("AH16").Value
            Worksheets(NomFeuille).[E8] = Range("AI16").Value
            [AH19] = Worksheets(NomFeuille).Range("D15").Value
            [AI19] = Worksheets(NomFeuille).Range("E15").Value
        ElseIf CalendrierMois = "Juillet" Then
            Worksheets(NomFeuille).[D9] = Range("AH16").Value
            Worksheets(NomFeuille).[E9] = Range("AI16").Value
            [AH19] = Worksheets(NomFeuille).Range("D15").Value
            [AI19] = Worksheets(NomFeuille).Range("E15").Value
        ElseIf CalendrierMois = "Août" Then
            Worksheets(NomFeuille).[D10] = Range("AH16").Value
            Worksheets(NomFeuille).[E10] = Range("AI16").Value
            [AH19] = Worksheets(NomFeuille).Range("D15").Value
            [AI19] = Worksheets(NomFeuille).Range("E15").Value
        ElseIf CalendrierMois = "Septembre" Then
            Worksheets(NomFeuille).[D11] = Range("AH16").Value
            Worksheets(NomFeuille).[E11] = Range("AI16").Value
            [AH19] = Worksheets(NomFeuille).Range("D15").Value
            [AI19] = Worksheets(NomFeuille).Range("E15").Value
        ElseIf CalendrierMois = "Octobre" Then
            Worksheets(NomFeuille).[D12] = Range("AH16").Value
            Worksheets(NomFeuille).[E12] = Range("AI16").Value
            [AH19] = Worksheets(NomFeuille).Range("D15").Value
            [AI19] = Worksheets(NomFeuille).Range("E15").Value
        ElseIf CalendrierMois = "Novembre" Then
            Worksheets(NomFeuille).[D13] = Range("AH16").Value
            Worksheets(NomFeuille).[E13] = Range("AI16").Value
            [AH19] = Worksheets(NomFeuille).Range("D15").Value
            [AI19] = Worksheets(NomFeuille).Range("E15").Value
        ElseIf CalendrierMois = "Décembre" Then
            Worksheets(NomFeuille).[D14] = Range("AH16").Value
            Worksheets(NomFeuille).[E14] = Range("AI16").Value
            [AH19] = Worksheets(NomFeuille).Range("D15").Value
            [AI19] = Worksheets(NomFeuille).Range("E15").Value
        End If
    End If
End Sub

merci pour votre aide ;)

Commence par mettre tes mois en numérique (perso, je les mettrais même en date en jouant sur le format), sinon il faudra mettre en Select Case pour renseigner la variable Mois.

Code:

1
2
3
4
5
6
7
8
9
10
11
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
   Dim Mois As Integer, Annee As Integer
 
   Mois = Range("H1").Value
   Annee = Range("D1").Value
 
   Worksheets("Stats").Cells(2 + Mois, Annee - 2015) = Range("AH16").Value
   Worksheets("Stats").Cells(2 + Mois, Annee - 2014) = Range("AI16").Value
   Range("AH19").Value = Worksheets("Stats").Cells(15, Annee - 2015).Value
   Range("AI19").Value = Worksheets("Stats").Cells(15, Annee - 2015).Value
End Sub

15/02/2017, 21h56
clementmarcotte

Bonjour,

Citation:

Envoyé par Menhir

Commence par mettre tes mois en numérique (perso, je les mettrais même en date en jouant sur le format),

Ou bien avec DatePart ou avec Month
15/02/2017, 22h19
mercatog

En 2017 faire en vba un calendrier qui va jusqu'à 2050 c'est comme faire en 1983 en basic un code en prévision de 2016
15/02/2017, 22h44
Invité

Bonsoir,
Si tu as des réservations jusqu'à 2050 encaisses le chèques de réservation et tire toi!

Qu'est qui justifie 2050?

Bonjour merci pour vos réponses ;)

pour le coup je suis partis sur select case
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 Select Case CalendrierAnnée Case 2017 a = "B" b = "C" Case 2018 a = "D" b = "E" End Select Select Case Calendriermois Case "Janvier" c = 3 Case "Février" c = 4 Case "Mars" c =5 End Select Worksheets(NomFeuille).Range(a & c) = Range("AH16").Value Worksheets(NomFeuille).Range(b & c) = Range("AI16").Value [AH19] = Worksheets(NomFeuille).Range("B15").Value 'pas besoin de répéter ces 2 lignes [AI19] = Worksheets(NomFeuille).Range("C15").Value
Pourquoi 2050 je voulais quelque chose ou je ne suis pas obliger de revenir dessus dans 5 ou 10 ans. comme j'ai un projet personnel entre maintenant et la création de ma boite je préfère mi prendre maintenant. Car quand je vois le temps que je viens de passer a créer le projet excel j'ai pas envie de perdre se temps quand je vais créer ma boite.

Voila pourquoi, après j'ai peux être vue un peut trop loin ;)

Maintenant j'ai une autre question, je viens de m’apercevoir que je suis obliger de cliquer sur une cellule pour mettre a jour l'autre feuille ou sont stocker les données.
Ma question est: comment avec la liste déroulante pour sélectionné le mois et l'année que sa stocke mes données sans à avoir a cliquer sur une cellule ??

merci a vous ;)

16/02/2017, 12h34
Invité

Citation:

Envoyé par chrisl0

Bonjour merci pour vos réponses ;)

Pourquoi 2050 je voulais quelque chose ou je ne suis pas obliger de revenir dessus dans 5 ou 10 ans. comme j'ai un projet personnel entre maintenant et la création de ma boite je préfère mi prendre maintenant. Car quand je vois le temps que je viens de passer a créer le projet excel j'ai pas envie de perdre se temps quand je vais créer ma boite.

bonjour,
tu ne compte pas faire de profits? tu ne compte pas si tu gagne de l'argents investir dans un outils genre caisse enregistreuse comme pour les réservations d’hôtel?

2050 tu envisage ta succession? t'oublis pas de te rendre chez le notaire pour rédiger ton testament! remarque (chrisl0) on est jamais trop prudent le christ est mort à 33 ans (2050 - 2017=33)!
16/02/2017, 12h38
chrisl0

Re si bien-sur que je compte faire des profits mais quand tu peux le faire toi même pourquoi acheter des truc tout fait ??
16/02/2017, 17h41
Menhir

Citation:

Envoyé par clementmarcotte

Ou bien avec DatePart ou avec Month

Etant donné qu'il n'a pas des vraies dates mais des mois écrits en littéral, ces fonctions sont inutilisables.
J'avais pensé passer par un DateValue (puis un Month) mais il y a 90% de chance que ça ne marche pas, surtout avec des mois écrits en français.

Citation:

Envoyé par chrisl0

pour le coup je suis partis sur select case

Pour les numéro d'années, une formule serait plus pratique.
A mettre dans un Cells plutôt qu'un Range pour ne pas avoir à mettre les colonnes en lettres.

Citation:

Maintenant j'ai une autre question, je viens de m’apercevoir que je suis obliger de cliquer sur une cellule pour mettre a jour l'autre feuille ou sont stocker les données.
Ma question est: comment avec la liste déroulante pour sélectionné le mois et l'année que sa stocke mes données sans à avoir a cliquer sur une cellule ??

Pas vraiment claire ta question... :?
Mais je pense que tu dois pouvoir résoudre ça avec une macro évènementielle Worksheet_Change.
https://msdn.microsoft.com/fr-fr/lib.../ff839775.aspx
17/02/2017, 10h19
chrisl0

Merci a vous pour vos réponse elles m'ont bien aider ;)