XL 2016 Aide pour améliorer un code vba

Créer une discussion
Répondre

Boostez vos compétences Excel avec notre communauté !

Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force. Apprenez, échangez, progressez – et tout ça gratuitement ! 👉 Inscrivez-vous maintenant !

S'inscrire
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
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
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
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

Vote positif 0 Vote négatif
Rejoins nos membres "Supporter XLD" et booste ton expérience Excel !
- Navigue sans publicité
- Accède à Cléa, notre assistante IA experte Excel... et pas que...
- Profite de fonctionnalités exclusives
Ton soutien permet à Excel Downloads de rester 100% gratuit et de continuer à rassembler les passionnés d'Excel.
Je deviens Supporter XLD

Discussions similaires

S
  • Résolu(e)
Microsoft 365 VBA Match: comment éviter l'erreur?
2
Réponses
29
Affichages
915
Dranreb
Dranreb
thunder23
  • Résolu(e)
XL 2021 Bug dans code vba
Réponses
8
Affichages
647
thunder23
thunder23
M
  • Résolu(e)
XL 2016 Amélioration de code
Réponses
3
Affichages
804
M@xu3L
M
L
  • Question Question
XL 2021 Comment utiliser la colonne d'une adresse en Private Sub - svp ?
Réponses
3
Affichages
533
vgendron
vgendron
L
  • Question Question
VBA : erreur sur boucle
Réponses
2
Affichages
434
Latias
L
C
  • Question Question
XL 2019 Code VBA si feuille existe la remplacé Résolu
Réponses
2
Affichages
1 K
celtar
C
D
  • Question Question
Microsoft 365 Code VBA pour date DD/MM/YYYY
Réponses
6
Affichages
430
Staple1600
Staple1600
N
  • Résolu(e)
Microsoft 365 Aide pour terminer un code Vba Excel
2
Réponses
23
Affichages
1 K
job75
job75
yojema
  • Question Question
XL 2021 faire évoluer un code VBA
Réponses
3
Affichages
578
Dranreb
Dranreb
tactic6
  • Question Question
XL 2016 Aide pour userform (sujet clos)
Réponses
8
Affichages
589
tactic6
tactic6
looky62
  • Question Question
Microsoft 365 VBA Colorise un doublon dans feuil différente
Réponses
2
Affichages
501
Oneida
Oneida
L
  • Question Question
XL 2016 code VBA - masque afficher des lignes
Réponses
3
Affichages
638
Jacky67
Jacky67
Phillip
  • Question Question
XL 2016 Excel vba : faire une action sur certaines feuilles d'un classeur
Réponses
7
Affichages
876
Dranreb
Dranreb
I
  • Question Question
XL 2016 Mon code VBA me renvoi une erreur
Réponses
6
Affichages
827
INFINITY100
I
L
  • Résolu(e)
XL 2016 finaliser mon code VBA
Réponses
8
Affichages
841
Linda42
L
H
  • Question Question
Microsoft 365 Besoin aide : Erreur code macro . Problème est résolu
Réponses
7
Affichages
985
heart clean
H
R
  • Résolu(e)
XL 2016 Aide pour finaliser un code Vba
Réponses
8
Affichages
789
TooFatBoy
TooFatBoy
I
  • Question Question
XL 2016 Modification d'une ligne dans mon code
Réponses
2
Affichages
651
INFINITY100
I
W
  • Résolu(e)
XL 2019 Macro VBA pour remplacer fonction par valeur si condition respecté
Réponses
5
Affichages
1 K
WinnieJ
W
M
  • Question Question
XL 2016 Aide code VBA
Réponses
7
Affichages
757
medsoft313
M
Retour