correction de la macro pour le vendredi
Sub ETABLIR()
Dim wb As Workbook
Dim ws As Worksheet
Dim wsMois As Worksheet
' effacement des données actuelles des différents onglets
RAZ
' application actuelle et feuille principale
Set wb = ThisWorkbook
Set ws = ActiveSheet
' ouverture du fichier avec les données source
Workbooks.Open Filename:=ActiveWorkbook.Path & "\" & Range("fichier") & ".xlsx"
For quand = ws.Range("depuis").Value To ws.Range("jusque").Value
' détermination du n° de colonne suivant le jour
col = 0
If quand = ws.Range("depuis").Value Then col = 1
If quand = ws.Range("depuis").Value + 1 Then col = 4
If quand = ws.Range("depuis").Value + 3 Then col = 7
If quand = ws.Range("depuis").Value + 4 Then col = 10
' pour chaque feuille du fichier de données
For Each wsMois In Worksheets
wsMois.Select
j = 1
' recherche de correspondance dans la ligne 6 contenant les dates
Do Until Cells(6, j).Value = quand Or j = Cells(6, Columns.Count).End(xlToRight).Column
j = j + 1
Loop
' à ce stade, j est la colonne correspondant à la date recherchée
' ok date trouvée
If Cells(6, j).Value = quand Then
' les noms sont en colonne A, la liste commence à 7 et s'arrête à la première case vierge
For i = 7 To Range("A6").End(xlDown).Row
If Cells(i, j) <> "" Then
' cette gestion d'erreur permet d'ignorer l'instruction si col=0 ou si la classe n'est pas un onglet
On Error Resume Next
der = wb.Sheets(Cells(i, "C").Value).Cells(Rows.Count, col).End(xlUp).Row + 1
wb.Sheets(Cells(i, "C").Value).Cells(der, col).Value = Cells(i, "A").Value
On Error GoTo 0
' fin d'exception
End If
Next
End If
Next
Next
' fermeture fichier source sans changements
ActiveWindow.Close Savechanges:=False
' préparation de l'édition
For Each ws In wb.Sheets
With ws
If .Name <> "EDITION" Then
.PageSetup.PrintArea = "$A$1:$K$" & .Range("M4").Value + 5
End If
End With
Next
End Sub
Sub RAZ()
Dim ws As Worksheet
' effacement des données actuelles des différents onglets
For Each ws In Worksheets
With ws
If .Name <> "EDITION" Then
' M4 donne le nombre max par jour d'élèves de la feuille
If .Range("M4").Value > 0 Then .Rows("5:" & (.Range("M4").Value + 4)).ClearContents ' les données commencent ligne 5
End If
End With
Next
End Sub