Bonjour ou Bonsoir à tous,
 
Voila je bloque sur un problème, je débute en VBA et je souhaite réaliser une macro qui me permettrait de reprendre différentes données sur les 38 feuilles que j'ai.
Les feuilles sont toutes identiques, elles ont la même présentation.
Les données que je dois reprendre sont le nom, prénom, fonction, age ----> ces données sont en A8, D8, F8, H8
Quatre autres données doivent aussi être reprises : Une date, nombre de jour, autre, motif.
 
Toutes ces données doivent ensuite être mise dans un rapport journalier.
 
Exemple:
 
Vérificateur --- Nom --- Prénom --- Age : En congé X jours à la date du ....
ou
Vérificateur --- Nom --- Prénom --- Age : En Maladie X jours à la date du ....
ou
Vérificateur --- Nom --- Prénom --- Age : En déplacement X jours à la date du ....
 
Que faire pour réaliser une telle Macro en sachant qu'il y a deux sortes de personnel Cadre et Employé.
 
Merci pour votre aide
 
JJ

bonjour,
as-tu essayé d'enregistrer une macro pour en tirer le code?
 
Cordialement

Bonjour seniorpapou,
 
Oui, j'ai essayé, mais le problème que j'ai rencontré est qu'il ouvre les feuilles prends les données mais les copies sur la page Rapport mais toujours au même endroit.
Il faut savoir que chaque personne à une feuille et que toutes les personnes ne sont pas absentes le même jour.

Re,
juste pour que tu puisses t'en inspirer:
 
feui = 2
limit = Worksheets(feui).Cells(65527, 2).End(xlUp).Row
zone = "b1:c" & limit
'Sheets("Feuil2" ).Select
basdeB = Worksheets(1).Cells(65527, 2).End(xlUp).Row + 1
oujcol = "B" & basdeB
   Worksheets(feui).Range(zone).Copy _
    Destination:=Worksheets(1).Range(oujcol)
 
Cordialement

Merci pour ton aide,
 
voici le code  
Sub Rapport()
 
Dim fd As Worksheet 'Feuille destination
Dim fs As Worksheet 'Feuille source (de la copie)
Dim Lig     As Long
Dim Col     As String
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" )
 
 'Effacement Feuille destination
  fd.Cells.Clear
 
 'Ecriture de l'entête sur Feuille destination
  fd.Activate
  fd.Cells(3, 10) = "Annexe(s) :"
  fd.Cells(8, 2) = "Objet :"
  fd.Cells(8, 4) = "Rapport Journalier du "
  fd.Cells(10, 4) = "Personnel :"
 
  Col = "A"                 ' colonne données non vides à tester'
  NumLig = 11
  With Sheets("Nom" )  'feuille source
  NbrLig = .Cells(100, Col).End(xlUp).Row
  For Lig = 15 To NbrLig             'n° de la 1ere ligne de données'
    If .Cells(8, 1).Value <> "" Then
       .Cells(8, 1).EntireRow.Copy
       NumLig = NumLig + 1
       Cells(NumLig, 1).Select
       ActiveSheet.Paste
    End If
  Next
  End With
 
voila
 
JJ

Mais je ne parviens pas à mettre le complément de données sur la même ligne, cad en congé ou les autres motifs qui sont dans les autres lignes.
 
Merci pour l'aide
 
JJ

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

http://forum.hardware.fr/hfr/Progr [...] 0232_1.htm

Merci kiki29 pour l'info
 
Mais ici ce sont des feuilles ou sheet d'un même fichier avec prise de renseignement et mise en page dans un rapport.
 
J'avais vu le post.
 
Au fait comment cloturer le post ?
 
JJ

Bonsoir,
Tu te positionnes sur ton premier post, tu cliques sur éditer le message, puis tu modifies le titre en mettant [RESOLU]
Cordialement