[XL2010] Somme partielle ou recopie automatique par VBA

ThorGnole

XLDnaute Nouveau
Bonsoir, je dois réaliser un plan de charge pour une activite partielle a partir du planning global pour mon chef. Pour ce faire, j'extrait la partie concernée dans un nouveau fichier (voir onglet EXTRACTION BRUT) et je souhaiterais mettre en forme les donnees extraites (voir onglet RESULTAT FINAL SOUHAITE)

J'arrive, grace a votre merveilleux forum, a mettre en forme l'extraction mais je n'arrive pas à calculer les sommes partielles dans la colonne I, entre les cases sous la case jaune et une case vide. (je l'ai fait avec des formules mais je souhaiterais si possible l'integrer a la macro de mise en forme)

Le probleme est que sur certaines semaine, il y a 4 lignes a prendre en compte et sur certaines autres 10, 12 ....c'est aléatoire.

Une autre méthode serait d'inserer les cases en orange, recopier la case en jaune du dessus (c'est deja le total extrait) et finalement masquer le total de la case en jaune (avec une couleur jaune sur jaune , ca serait parfait)

Merci de votre aide
Alex
 

Pièces jointes

  • Support_aide.xlsm
    26.6 KB · Affichages: 115

Softmama

XLDnaute Accro
Re : [XL2010] Somme partielle ou recopie automatique par VBA

bonjour,
VB:
Sub Insereligne()
Dim Vprenom As Range, Plage As Range
Dim DerniereLigne As Long, Ligne As Long

Application.ScreenUpdating = False

DerniereLigne = Cells(300, 7).End(xlUp).Row
Set Plage = Range(Cells(1, 7), Cells(DerniereLigne, 7))
For Each Vprenom In Plage
    If Vprenom = "S" Then
        Range(Cells(Vprenom.Row, 1), Cells(Vprenom.Row, 9)).Interior.ColorIndex = 6
        If Cells(Vprenom.Row - 1, 7).Value = "" Then GoTo Poursuivre 'Pour dire que vous avez déjà ajouté la ligne
        Cells(Vprenom.Row, 7).EntireRow.Insert Shift:=xlDown
        Cells(Vprenom.Row, 7).EntireRow.Insert Shift:=xlDown
        
    
  
Poursuivre:

    
    
    End If
    
    If Vprenom <> "" Then
     With Range(Cells(Vprenom.Row, 1), Cells(Vprenom.Row, 9)).Borders
      .LineStyle = xlContinuous
      .Weight = xlThin
     End With
    End If
    
Next Vprenom
Dim c As Range, d As Range
Set c = Range("I1").End(xlDown)
Do
 Set d = c.End(xlDown)
 If d.Row < 10000 Then
   Set d = d.Offset(1)
   d = c: d.Offset(, -1) = "Nb Heures"
   d.Offset(, -1).Resize(, 2).Interior.ColorIndex = 44
   c = ""
   Set c = d.Offset(1).End(xlDown)
 Else
   Exit Sub
 End If
Loop
End Sub

vois ton fichier en retour.
 

Pièces jointes

  • Support_aide.xls
    48.5 KB · Affichages: 102

Discussions similaires