Macro moyenne + nbval + copier coller sur une autre feuille

  • Initiateur de la discussion Initiateur de la discussion mdelbos
  • Date de début Date de début

Boostez vos compétences Excel avec notre communauté !

Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force. Apprenez, échangez, progressez – et tout ça gratuitement ! 👉 Inscrivez-vous maintenant !

mdelbos

XLDnaute Nouveau
Bonjour, j'utilise une macro pour calculer automatiquement les moyennes en fonction de l'origine. Je souhaiterai rajouter dans cette ligne générée automatiquement une formule "nbval" pour me calculer automatiquement le nombre d'élèves et que cette ligne soit aussi automatiquement coller dans un tableau de synthèse sur une autre feuille... Est-ce possible ?
PS: je n'y connais pas grand chose en macro pouvez-vous m'aider ????🙂

Sub MoyenneO()
Dim I As Long, dercol As Byte, plage As Range

Application.ScreenUpdating = False
With Sheets("origine")

For I = .Range("E65536").End(xlUp).Row To 4 Step -1
If .Cells(I, 5) Like "Moyennes *" Then .Cells(I, 5).EntireRow.Delete 'suppression des lignes de moyennes
Next
.Rows("4:65536").Sort Key1:=.Range("E4"), Order1:=xlAscending, _
Key2:=.Range("A4"), Order2:=xlAscending, Header:=xlNo 'tri du tableau

dercol = .Range("IV3").End(xlToLeft).Column 'dernière colonne à remplir
For I = .Range("E65536").End(xlUp).Row + 1 To 5 Step -1
If .Cells(I - 1, 5) <> .Cells(I, 5) Then
.Rows(I).Insert
.Rows(I).Borders(xlInsideVertical).LineStyle = xlNone 'supprime les bordures
.Cells(I, 1).Resize(, dercol).Interior.ColorIndex = 36 'colore la ligne en jaune
.Cells(I, 5) = "Moyennes " & .Cells(I - 1, 5)
If Not plage Is Nothing Then _
plage.FormulaR1C1 = "=AVERAGE(R[" & I - plage.Row + 1 & "]C:R[-1]C)"
Set plage = .Range(.Cells(I, 7), .Cells(I, dercol))
End If
Next
plage.FormulaR1C1 = "=AVERAGE(R[" & 4 - plage.Row & "]C:R[-1]C)" 'il y a encore une ligne de moyennes à remplir...

End With
End Sub
 
Dernière édition:
- Navigue sans publicité
- Accède à Cléa, notre assistante IA experte Excel... et pas que...
- Profite de fonctionnalités exclusives
Ton soutien permet à Excel Downloads de rester 100% gratuit et de continuer à rassembler les passionnés d'Excel.
Je deviens Supporter XLD

Discussions similaires

Réponses
5
Affichages
236
Réponses
8
Affichages
466
  • Question Question
Microsoft 365 worksheet_change
Réponses
29
Affichages
479
Réponses
4
Affichages
177
Retour