XL 2016 Aide pour améliorer un code vba

Don pépé

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 ;)
 
Trier par date Trier par votes
B

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
 
Vote positif 0 Vote négatif
Don pépé

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:
Vote positif 0 Vote négatif
B

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
Cliquez pour agrandir...
je ne comprend pas
 

Pièces jointes

  • TableauResa_sur_1_moisV1.xlsm
    62.1 KB · Affichages: 33
Vote positif 0 Vote négatif

Discussions similaires

M
  • Résolu(e)
XL 2016 Amélioration de code
Réponses
3
Affichages
560
M@xu3L
M
L
  • Question
XL 2021 Comment utiliser la colonne d'une adresse en Private Sub - svp ?
Réponses
3
Affichages
445
vgendron
vgendron
C
  • Question
XL 2019 Code VBA si feuille existe la remplacé Résolu
Réponses
2
Affichages
1 K
celtar
C
L
  • Question
VBA : erreur sur boucle
Réponses
2
Affichages
281
Latias
L
N
  • Résolu(e)
Microsoft 365 Aide pour terminer un code Vba Excel
2
Réponses
23
Affichages
995
job75
job75
yojema
  • Question
XL 2021 faire évoluer un code VBA
Réponses
3
Affichages
426
Dranreb
Dranreb
looky62
  • Question
Microsoft 365 VBA Colorise un doublon dans feuil différente
Réponses
2
Affichages
424
Oneida
Oneida
L
  • Question
XL 2016 code VBA - masque afficher des lignes
Réponses
3
Affichages
578
Jacky67
Jacky67
tactic6
  • Question
XL 2016 Aide pour userform (sujet clos)
Réponses
8
Affichages
458
tactic6
tactic6
Phillip
  • Question
XL 2016 Excel vba : faire une action sur certaines feuilles d'un classeur
Réponses
7
Affichages
779
Dranreb
Dranreb

Membres actuellement en ligne

Aucun membre en ligne actuellement.
0 membres et 33 invités.

Partager cette page

Tutos vidéos

Power Query : Ajouter des requêtes (Excel et Power BI)
Créez votre première fonction LAMBDA dans Excel en 3 étapes!
LAMBDA, l’arme secrète de Microsoft pour Excel !
Office Insider - Découvrez les nouveautés Excel avant tout le monde

Statistiques des forums

Discussions
315 127
Messages
2 116 534
Membres
112 771
dernier inscrit
mikadu49