XL 2019 Automatiser l'incrémentation de montant pour calcul d'horaires sous VBA

[nikerems]

Bonjour,

Je vous contacte pour savoir comment l'on pourrait s'y prendre pour automatiser l'incrémentation de montants liés aux calculs d'heures supplémentaires, de temps d'astreintes et de temps d'intervention lors d'astreintes en s'appuyant sur VBA.

L'idée, à partir du fichier en PJ, est que chaque onglet "mois en cours" représente la situation d'un salarié.Cet onglet sera dupliqué manuellement ("mois en cours (2)", "mois en cours (3)") jusqu'à 10 potentielles duplications et l'ensemble des cellules C2, C3, C4, G2 et G3 sera préalimentée à partir d'une liste qui figurera dans l'onglet import, à laquelle sera également ajoutée les informations liées aux mode de traitement, matricule, employeur, motif, date de début et date de fin (demandé par l'onglet export)

Les colonnes
Après ce remplissage manuel, je souhaiterais pouvoir remonter le contenu des cellules suivantes (si différent de 0) issues des onglets "mois en cours":

- J43 (heures supp à 125%)
- J44 (heures supp à 150%)
- BS43 (nombre d'heures d'astreinte de jour sans intervention)
- BV43 (nombre d'heures d'astreinte de nuit sans intervention)

Et les faire s'incrémenter dans l'onglet "import variable" en remontant les infos figurant en haut du fichier "mois en cours", le nom de la variable, et le contenu des cellules précisées ci-dessus dans la colonne "base".

Auriez-vous connaissance d'une macro (avec une boucle j'imagine) qui permettrait de faire cela ? Je vous remercie,

Nikerems

 

[sousou]

Bonjour
Pa certain d'avoir tout saisie, mis ce code basé sur des tableaux de correspondance devrait t'être utile,
a adapter ,( bien remplir les tableaux)
listes et dest associe les adresse des données au colonnes de rangement
valeurs, représente les adresses de tout ce que tu veux récuperer en colonnes 'base'

Sub copies()
Set f = Sheets("Mois en cours")
listes = Array("m1", "c2", "s2", "c3", "m3",)
dest = Array(3, 1, 6, 4, 2)
valeurs = Array("j43", "j44", "bs43", "bv43")

drlg = Sheets("import variable_").Columns(1).End(xlDown).Row + 1
For v = 0 To UBound(valeurs)
For d = 0 To UBound(dest)
Sheets("import variable_").Cells(drlg, dest(d)) = f.Range(listes(d)).Value
Next
Sheets("import variable_").Cells(drlg, 9) = f.Range(valeurs(v)).Value
drlg = drlg + 1
Next
End Sub

 

[nikerems]

Bonjour
Pa certain d'avoir tout saisie, mis ce code basé sur des tableaux de correspondance devrait t'être utile,
a adapter ,( bien remplir les tableaux)
listes et dest associe les adresse des données au colonnes de rangement
valeurs, représente les adresses de tout ce que tu veux récuperer en colonnes 'base'

Sub copies()
Set f = Sheets("Mois en cours")
listes = Array("m1", "c2", "s2", "c3", "m3",)
dest = Array(3, 1, 6, 4, 2)
valeurs = Array("j43", "j44", "bs43", "bv43")

drlg = Sheets("import variable_").Columns(1).End(xlDown).Row + 1
For v = 0 To UBound(valeurs)
For d = 0 To UBound(dest)
Sheets("import variable_").Cells(drlg, dest(d)) = f.Range(listes(d)).Value
Next
Sheets("import variable_").Cells(drlg, 9) = f.Range(valeurs(v)).Value
drlg = drlg + 1
Next
End Sub

Bonjour Sousou,

Merci pour ton retour; au final mon fichier va s'enrichir, je suis en train de voir la meilleure manière de le présenter, je vais intégrer la macro en la paramétrant du mieux possible et croiser les doigts pour que tu sois dispo en milieu de semaine afin de faire un essai ensemble, si cela te va.

Merci encore,

Nikerems

 

[nikerems]

Bonsoir Sousou (et bonsoir à tous !),
J'ai amélioré nettement mon fichier, je pense que la demande est plus simple à présent.
L'objectif est de pouvoir intégrer les lignes 49 à 58 des onglets "mois en cours" (onglet unique pour l'instant mais sera dupliqué plusieurs fois, en "mois en cours (2) etc.) pour les intégrer les uns à la suite des autres dans l'onglet export (les colonnes ont été mises dans le même ordre que dans l'onglet "mois en cours".
Est-ce qu'il y aurait une macro simple pour faire cela ?
Je vous remercie,
Nikerems

 

[sousou]

Bonsoir
Tu peux essayer ceci, et toujours si j'ai compris
Sub copie()
For Each f In Sheets
If Left(f.Name, 13) = "Mois en cours" Then
f.Range("b49:i58").Copy
Sheets("export").Cells(drlg(Sheets("export"), 1) + 1, 1).PasteSpecial (xlPasteValues)
End If
Next
MsgBox drlg(Sheets("export"), 1)
End Sub


Function drlg(f, c)

drlg = f.Cells(f.UsedRange.Rows.Count + 1, c).End(xlUp).Row
End Function

 

[nikerems]

C'est exactement ce que je souhaitais faire Sousou !
Merci beaucoup !