XL 2016 Aide pour améliorer un code vba

Don pépé

XLDnaute Occasionnel
Bien le bonjour
icon_wink.gif


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 moins de lignes

le code qui est juste sur deux ans
Code :
VB:
Dim CalendrierMois
Dim CalendrierAnnée As Integer
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 bien a vous ;)
 

Bebere

XLDnaute Barbatruc
bonsoir
une idée à compléter
Code:
    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(a & 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
 

Don pépé

XLDnaute Occasionnel
Salut merci pour ta proposition

Sa fonctionne très bien.
sauf pour les deux dernière lignes qui change elle aussi avec l'année: 2017 b15 & c15 2018 d15 & e15 ...
J'ai essayer de mettre un autre select case mais sa fonctionne pas

VB:
Select Case total1
        Case "total"
            d = 15
        Case "total"
            d = 15
    End Select
            [AH19] = Worksheets(NomFeuille).Range(a & d).Value
            [AI19] = Worksheets(NomFeuille).Range(a & d).Value

Mais j'ai un autre souci que je viens de découvrir je suis obliger de cliquer sur une pour que sa incrémente les cellule sur l'autre feuille.

Ma question est: Comment je peux faire quand je change de mois pour que sa incrémente auto sur l'autre feuille
 
Dernière édition:

Bebere

XLDnaute Barbatruc
bonjour
Don pépé changer le code de calendrier pour qu'il réagisse sur changement de D1 ou H1,en B15 de stats autre écriture de la formule
Mais j'ai un autre souci que je viens de découvrir je suis obliger de cliquer sur une pour que sa incrémente les cellule sur l'autre feuille.

Ma question est: Comment je peux faire quand je change de mois pour que sa incrémente auto sur l'autre feuille
je ne comprend pas
 

Pièces jointes

  • TableauResa_sur_1_moisV1.xlsm
    62.1 KB · Affichages: 33

Discussions similaires

Statistiques des forums

Discussions
311 735
Messages
2 082 024
Membres
101 873
dernier inscrit
excellllll