Mise en forme calendrier

Bonjour,

J'essai d'automatiser la mise en forme d'un calendrier à partir d'un planning d'équipe.

Le fichier est en PJ, j'ai un bouton "Planning Consultant" qui va ouvrir mon Userform.

Dans le UserForm, je dois sélectionner le trigramme d'un consultant à l'aide d'une liste déroulante, et l'année souhaité.

Le but étant d'avoir un calendrier lisible rapidement avec une visu sur un an.

Le userform va créer un nouveau fichier contenant un calendrier avec la mise en forme souhaité.

Je bloque sur la copie du contenu des cellules du fichier de base sur mon nouveau fichier.

Les critères pour savoir quoi copié sont le trigramme de I8 à X8 du consultant qui va définir la colonne à copier et la date dans la colonne H.

Tous le contenu de la colonne cible sera a copié en gardant la mise en forme dans la 4 ème colonne du mois sur le fichier crée.

C'est pas forcément parlant comme ça mais en regardant le fichier je pense que ça sera plus clair.

Si une ame charitable peu jeter un oeil, je vous devrait une reconnaissance éternelle :)

J'ai essayé pas mal de chose mais rien à faire. un exemple de code testé mais infructueux. Du coup j'ai laissé dans le code du UserForm uniquement tous ce qui fonctionne bien.

Merci

    ' Appeler la procédure pour copier les données depuis l'onglet "Planning"
    CopierDonneesDuMois ThisWorkbook.Sheets("Planning"), ws, trigramme
End Sub

' Procédure pour copier les données du mois en cours depuis l'onglet "Planning"
Sub CopierDonneesDuMois(wsPlanning As Worksheet, wsCalendrier As Worksheet, trigramme As String)
    Dim currentMonth As Integer
    Dim currentDay As Integer
    Dim planningDate As String
    Dim targetRange As range
    Dim foundCell As range

    ' Boucle pour parcourir chaque mois
    For currentMonth = 1 To 12
        ' Boucle pour copier les données pour chaque jour du mois
        For currentDay = 3 To 33 ' Ajustez les plages de cellules selon votre configuration
            ' Recherche de la date dans la colonne H de l'onglet "Planning"
            Dim dateString As String
            dateString = wsCalendrier.Cells(currentDay, (currentMonth - 1) * 4 + 1).Value
            Dim parts() As String
            parts = Split(dateString, " ")
              If UBound(parts) = 2 Then
                Dim day As Integer
                Dim mois As Integer
                Dim year As Integer
                day = Val(parts(1))
                mois = month(dateValue(parts(2) & " 1"))
                year = Val(parts(3))
    ' Créer une date à partir des éléments extraits
                planningDate = DateSerial(year, mois, day)

                Set foundCell = wsPlanning.Columns(8).Find(planningDate, wsPlanning.Cells(2, 8))

                If Not foundCell Is Nothing Then
                    ' Copier les données du mois actuel depuis l'onglet "Planning" en conservant la mise en forme
                    Set targetRange = wsCalendrier.Cells(currentDay, (currentMonth) * 4 + 1)
                    wsPlanning.Cells(foundCell.Row, trigramme).Copy
                    targetRange.PasteSpecial xlPasteAll
                End If
            End If
        Next currentDay
    Next currentMonth
End Sub

Bonjour,

Essayez ceci,

Avant de faire le test, allez dans le module 2, dans la macro "Complements", remplacez le nom du fichier "Planning.xlsm" par le nom de votre fichier (2 endroits).

Après exécution de la macro, les feuilles "Calendrier_Consultant" ne seront visibles qu'après avoir fermer le "Userform".

Cdlt

Merci beaucoup pour le coup de main, j'ai procéder un petit peu différemment mais je me suis aidé de votre solution pour arriver au résultat.

Merci :)