Voici la solution que m'a rédigé seniorpapou, j'avais une petite partie des données, le tout était de les mettre dans le bon sens. Avec son aide le final est génial.
Je le remercie vivement
Sub RapportExécution()
Dim fd As Worksheet 'Feuille destination
Dim fs As Worksheet 'Feuille source (de la copie)
Dim Lig As Long
Dim NbrLig As Long
Dim NumLig As Long
'feuille de destination
Sheets("Rapport" ).Activate
'On défini ici la feuille destination
Set fd = ThisWorkbook.Sheets("Rapport" )
Set categ = ThisWorkbook.Sheets("catpers" )
'Effacement Feuille destination
fd.Cells.Clear
Dim dateref As Date
dateref = InputBox("Donner la date pour le rapport en 00/00/0000" )
datref = CDate(dateref)
'Ecriture de l'entête sur Feuille destination
fd.Activate
Range("A1:E1" ).Select
With Selection
.HorizontalAlignment = xlCenter
End With
Selection.Merge
Selection.Font.Bold = True
fd.Cells(1, 1) = "texte"
Range("A6:E6" ).Select
With Selection
.HorizontalAlignment = xlCenter
End With
Selection.Merge
Selection.Font.Bold = True
fd.Cells(6, 1) = "texte"
Range("A7:E7" ).Select
With Selection
.HorizontalAlignment = xlCenter
End With
Selection.Merge
fd.Cells(7, 1) = "texte"
Range("A8:E8" ).Select
With Selection
.HorizontalAlignment = xlCenter
End With
Selection.Merge
fd.Cells(8, 1) = "texte"
fd.Cells(2, 17) = "Le " & datref
fd.Cells(3, 17) = "Annexe(s) :"
fd.Cells(11, 2) = "Objet :"
fd.Cells(11, 3) = "Rapport Journalier du : " & datref
Dim col As Long
col = 1
NumLig = 13 ' colonne données non vides à tester'
nbcat = categ.Cells(100, col).End(xlUp).Row
For cc = 1 To nbcat
catcher = categ.Cells(cc, 1)
Cells(NumLig, 1) = "Pour la catégorie : " & catcher
NumLig = NumLig + 1
For Each chochot In Sheets
nomsh = chochot.Name
indice = chochot.Index
If chochot.Name <> "Rapport" Then
'chochot.Select
With chochot
If .Cells(8, 1).Value <> "" And .Cells(8, 8) = catcher Then
.Cells(8, 1).EntireRow.Copy
'feuille source
NbrLig = Worksheets(indice).Cells(100, col).End(xlUp).Row
For Lig = 15 To NbrLig 'n° de la 1ere ligne de données'
Dim datedebutcg As Date
Dim datefincg As Date
datedebutcg = CDate(.Cells(Lig, 1))
datefincg = CDate(.Cells(Lig, 1)) + .Cells(Lig, 3) + .Cells(Lig, 4)
If dateref >= datedebutcg And dateref <= datefincg Then
'En maladie 10 jours à la date du 00/00/0000
NumLig = NumLig + 1
Cells(NumLig, 1).Select
ActiveSheet.Paste
motiv = .Cells(Lig, 5)
If IsNull(motiv) Or motiv = "" Then motiv = "inconnu"
absentpour = "En " & motiv & " pour " & .Cells(Lig, 3) & .Cells(Lig, 4) & " jour(s) à partir du " & .Cells(Lig, 1)
Cells(NumLig, 13) = absentpour
Exit For
End If
Next
End If
End With
End If
Next chochot
NumLig = NumLig + 1
Next cc
Range("P43:R43" ).Select
With Selection
.HorizontalAlignment = xlCenter
End With
Selection.Merge
fd.Cells(43, 16) = "texte"
Range("P44:R44" ).Select
With Selection
.HorizontalAlignment = xlCenter
End With
Selection.Merge
fd.Cells(44, 16) = "texte"
Range("P45:R45" ).Select
With Selection
.HorizontalAlignment = xlCenter
End With
Selection.Merge
fd.Cells(45, 16) = "texte"
fd.Cells(57, 1) = "_________________________________________"
fd.Cells(58, 1) = "texte"
Range("j58:q58" ).Select
With Selection
.HorizontalAlignment = xlCenter
End With
Selection.Merge
fd.Cells(58, 10) = "texte"
Range("c59:e59" ).Select
With Selection
.HorizontalAlignment = xlCenter
End With
Selection.Merge
fd.Cells(59, 3) = "texte"
Range("j59:q59" ).Select
With Selection
.HorizontalAlignment = xlCenter
End With
Selection.Merge
fd.Cells(59, 10) = "texte"
fd.Cells(60, 1) = "texte"
Range("j60:q60" ).Select
With Selection
.HorizontalAlignment = xlCenter
End With
Selection.Merge
fd.Cells(60, 10) = "texte"
fd.Cells(61, 1) = "texte"
Range("j61:q61" ).Select
With Selection
.HorizontalAlignment = xlCenter
End With
Selection.Merge
fd.Cells(61, 10) = "texte"
fd.Cells(62, 1) = "E-mail : texte"
Range("j62:q62" ).Select
With Selection
.HorizontalAlignment = xlCenter
End With
Selection.Merge
fd.Cells(62, 10) = "texte"
End Sub
FORUM HardWare.fr
