[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
 

Fichiers joints

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.
 

Fichiers joints

ThorGnole

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

Merci beaucoup Softmama, c'est exactement ce qu'il me fallait !!! :):)

Alex
 

Créez un compte ou connectez vous pour répondre

Vous devez être membre afin de pouvoir répondre ici

Créer un compte

Créez un compte Excel Downloads. C'est simple!

Connexion

Vous avez déjà un compte? Connectez vous ici.

Haut Bas