Listbox avec mois puis répartition heures par semaines/projets/codes

Bonjour à vous,

J'aurais besoin de votre aide sur un sujet sur lequel je bloque. Je souhaiterais que dans le fichier "Sociétés" si je sélectionne un mois quelque part (listbox en haut de la feuille ou je ne sais pas) alors les semaines référentes à ce mois du tableau qui est dessous soient copiées collées dans le fichier "Répartition heures". Je précise que les semaines référentes aux mois sont dans l'onglet "Calendrier" car ce ne sont pas les semaines calendaires. Les données qui devraient être copiées dans le fichier "répartition heures" sont les colonnes "Projet", "Code", et les heures par semaines.

Une fois les données copiées collées j'aimerais que lorsque dans la semaine 1 (colonne D du fichier "Répartition heures") il est affiché par exemple 300h que ça les répartissent dans le tableau à droite "semaine 1" sans que les heures dépassent 99h par jour (et avec le code associé à la ligne)

Pourriez-vous m'aider sur ce sujet car je ne sais pas trop comment l'aborder

Merci beaucoup

Bonjour Ninkasi,

Dans le fichier "Societes", feuille "Calendrier", il n'y a pas de semaines pour le mois de janvier !!

Est-ce un oubli ? Ou un bout que je n'ai pas compris ?

ric

Pardon oui je n’ai pas précisé mais janvier est différent on peut l’ignorer !

bonjour, comme debut une macro pour repartition, mais il y a des anomalies (comme W1 et W01, février >5 semaines, ...)

Sub Societe2()
     Dim Tab1(1 To 100, 1 To 2), Tab2(1 To 100, 1 To 5), Col(1 To 5)

     Set wb = Workbooks("societes.xlsm")     'l'autre fichier
     With wb.Sheets("société 2")     'ce société
          If Range("D2").Value = "" Then Exit Sub     'mois choisi
          iCol = Application.Match(.Range("D2").Value, wb.Sheets("calendrier").Range("B2:L2"), 0)     'trouver mois
          If Not IsNumeric(iCol) Then MsgBox "faux mois": Exit Sub
          semaines = Application.Transpose(wb.Sheets("calendrier").Range("A3:A7").Offset(, iCol))     'semaines correspondantes (max5)
          For i = 1 To 5
               If semaines(i) <> "" Then
                    r = Application.Match(semaines(i), .Range("T4:BS4"), 0)     'colonne de cette semaine
                    If IsNumeric(r) Then Col(i) = r
               End If
          Next

          For i = 5 To 20     'boucle les projects
               If .Range("B" & i).Value <> "" Then     'il a un nom
                    ptr = ptr + 1     'pointer
                    Tab1(ptr, 1) = .Range("B" & i).Value     'project & code dans Tab1
                    Tab1(ptr, 2) = .Range("C" & i).Value
                    For j = 1 To 5     'les 5 semaines dans Tab2
                         If Col(j) > 0 Then Tab2(ptr, j) = .Range("S" & i).Offset(, Col(j)).Value
                    Next
               End If
          Next
     End With

     With ThisWorkbook.Sheets("société 2")
          .Range("A3").Resize(18, 2).Value = Tab1
          .Range("D3").Resize(18, 5).Value = Tab2
     End With

End Sub

Bonjour Ninkasi, le forum,

Fichier "Sociétés" ... Les données des plages W1 à W24 ne correspondent pas aux bons mois selon les références Mois/semaines de la feuille "Calendrier".

Il semble y avoir un décalage d'un mois.

ric

Bonjour,

Merci beaucoup pour votre aide, oui les semaines par mois sont en décalées c'est normal car c'est du point de vue finance et les clôtures se font en cours de mois

Bonjour Ninkasi,

Est-ce que tu peux nous dire sur quelle/s plage/s il faut coller les informations dans le classeur "repartition-heures.xlsx" ?

ric

re,

la macro pour la feuille "Société 2"

Bonjour à tous,

Un essai ...

Basé sur l'excellent code très rapide de BsAlv, que l'on doit remercier ...

Le fichier Société peut varier de nom sans conséquence ...

Le code fonctionne sur les trois Sociétés ...

Il pourrait fonctionner sur d'autres sociétés (feuilles copiées > ajoutées).
Dans un tel cas, il faudrait aussi ajouter manuellement les feuilles dans le fichier "repartition-heures.xlsx".

En copiant la feuille, nul besoin de modifier le menu du mois "D2" ni le code du bouton voisin.
Le fichier "repartition-heures.xlsx ne peut pas varier de nom sans modifier le code.

Fichier Société, feuilles Sociétés ... les numéros de la colonne "A" sont utilisés pour à déterminer la dernière ligne ... donc essentiels.

J'ai ajouté, en "C1", dans le fichier "repartition-heures.xlsx, sur les feuilles Société, l'info du mois traité.

Il y a demande pour ouvrir "repartition-heures.xlsx" et gestion si on annule ou sélectionne le mauvais fichier.

Espérant le code sans trop de coquilles ...

ric

P.S. Nouveau fichier, code modifié selon les observations de BsAlv ... merci.

bonjour, je n'ai pas testé, j'ai simplement lu la code et il manquent 2 points qui correspondent avec le with ... end with, je pense

With WbSo.Sheets("Société " & X) ' cette société .

je n'ai pas mis ce code entre </>, autrement je ne pouvais pas utiliser des couleurs.

If .Range("D2").Value = "" Then Exit Sub ' mois choisi

icol = Application.Match(.Range("D2").Value, WbSo.Sheets("calendrier").Range("B2:L2"), 0) 'trouver mois

If Not IsNumeric(icol) Then MsgBox "faux mois": Exit Sub

semaines = Application.Transpose(WbSo.Sheets("calendrier").Range("A3:A7").Offset(, icol)) 'semaines correspondantes (max5)

For i = 1 To 5

If semaines(i) <> "" Then

r = Application.Match(semaines(i), .Range("T4:BS4"), 0) 'colonne de cette semaine

If IsNumeric(r) Then Col(i) = r

End If

Next

Derlig = .Cells(5, "A").End(xlDown).Row

Edit : non, je me trompe l'activesheet est le sheet pour ce with ... end with, on peut effacer quelque lignes

Bonjour à tous,

@BsAlv ... j'ai ajouté les 2 points manquants et changé le fichier dans mon post précédent ...

Merci oeil de lynx ...

ric

bonjour ric,

j'ai modifié un petit peu, pour moi c'est plus lisable (???)

Bonjour à tous,

Merci BsAlv pour ces améliorations ... je tente d'en tirer profit ... assurément ...

Il ne reste plus qu'à attendre les commentaires de l'intéressé : Ninkasi ...

ric