Recopie automatique

Bonjour,

j'aimerai réaliser un récapitulatif des absences pour cela j'ai créé une feuille "Absences" avec des tableaux récapitulatifs par services.

Par exemple je souhaiterai que toutes les absences d'urologie soient recopiées sur le tableau qui se trouve dans la feuille Absences

Ci joint mon tableau

Merci par avance

Cordialement

Bonjour

Alors première chose, défusionnez la ligne 4 et 5 de votre feuille Absence. Je me demande d'ailleurs pourquoi vous fusionnez ?

Ensuite faites un test en plaçant ce code dans un module de l'éditeur VBA qu'il vous suffit d'exécuter ensuite

Sub test()
Dim i As Integer, dlg As Integer

With Sheets("Urologie")
    For i = 4 To .Range("E" & Rows.Count).End(xlUp).Row
        If .Range("E" & i) <> "" And .Range("I" & i) <> "" Then
            dlg = Sheets("Absences").Range("B" & Rows.Count).End(xlUp).Row + 1
            Sheets("Absences").Range("B" & dlg) = .Range("E" & i).value
            Sheets("Absences").Range("C" & dlg) = .Range("F" & i).value
            Sheets("Absences").Range("D" & dlg) = .Range("I" & i).value
            Sheets("Absences").Range("E" & dlg) = Format(.Range("J" & i).value, "dd/mm/yyyy")
            Sheets("Absences").Range("F" & dlg) = Format(.Range("K" & i).value, "dd/mm/yyyy")
        End If

    Next i
End With
End Sub

N'oubliez pas d'enregistrer votre fichier au format XLSM (prenant en charge les macros)

Crdlt

Bonjour MANGO19, Dan , le forum,

Une variante.....la macro est exécutée à l'activation de la feuille ABSENCES....

Private Sub Worksheet_Activate()
 Dim tbU, newtbU(), tbV, newtbV()
 Dim i%, k%
 Dim urologie As Worksheet, vasculaire As Worksheet
  Set urologie = Sheets("Urologie"): Set vasculaire = Sheets("Vasculaire")
   tbU = urologie.Range("E4:K" & urologie.Range("E" & Rows.Count).End(xlUp).Row)
   tbV = vasculaire.Range("E3:K" & vasculaire.Range("E" & Rows.Count).End(xlUp).Row)

   k = 0
   ReDim newtbU(0 To UBound(tbU, 1), 1 To 5)
    For i = 1 To UBound(tbU, 1)
     If tbU(i, 1) <> "" And tbU(i, 5) <> "" Then
       newtbU(k, 1) = tbU(i, 1)
       newtbU(k, 2) = tbU(i, 2)
       newtbU(k, 3) = tbU(i, 5)
       newtbU(k, 4) = tbU(i, 6)
       newtbU(k, 5) = tbU(i, 7)
       k = k + 1
     End If
    Next i
   If k > 0 Then
    On Error Resume Next
    Range("B3").CurrentRegion.Offset(3, 0).ClearContents
    Range("B6").Resize(k, 5).Value = newtbU
   End If

   k = 0
   ReDim newtbV(0 To UBound(tbV, 1), 1 To 5)
    For i = 1 To UBound(tbV, 1)
     If tbV(i, 1) <> "" And tbV(i, 5) <> "" Then
       newtbV(k, 1) = tbV(i, 1)
       newtbV(k, 2) = tbV(i, 2)
       newtbV(k, 3) = tbV(i, 5)
       newtbV(k, 4) = tbV(i, 6)
       newtbV(k, 5) = tbV(i, 7)
       k = k + 1
     End If
    Next i
   If k > 0 Then
    On Error Resume Next
    Range("H3").CurrentRegion.Offset(3, 0).ClearContents
    Range("H6").Resize(k, 5).Value = newtbV
   End If
  Erase tbU: Erase tbV: Erase newtbU: Erase newtbV
 Set urologie = Nothing: Set vasculaire = Nothing
End Sub

Cordialement,

Bonjour,

merci beaucoup pour votre aide.

la proposition de xorsankukai me semble simple car je suis novice en excel. Dans le tableau présenté il y a que deux services mais en réalité j'en ai une dizaine du coup comment les intégrer par exemple orthopédie, gastro, ORL, OPH, caisson....?

dans la feuille récap "absences" chaque service son tableau comment préciser l'endroit par exemple si je souhaite postionner l'orthopédie sur la colonne B mais la ligne 40

Merci par avance

Bien cordialement

la proposition de xorsankukai me semble simple

Ok. Je lui laisse vous répondre.

Cordialement

Merci Dan

je vous souhaite une belle soirée

Cordialement

Bonsoir,

Merci pour le retour,

Un seul tableau recap ne suffirait-il pas ? Il suffit de rajouter une colonne SERVICE : bien plus simple à coder.

Un exemple ....

Il te suffit alors de rajouter les feuilles souhaitées sur cette ligne:

Set wsh = Sheets(Array("Urologie", "Vasculaire"))

exemple

Set wsh = Sheets(Array("Urologie", "Vasculaire", "Gastro","ORL"))

Elles doivent toutes être de configuration identique.

Cordialement,

Bonjour Xorsankukai,

Un immense merci tout fonctionne parfaitement et votre idée de tout regrouper sur le même tableau est judicieuse.

j'aimerai savoir s'il est possible de rajouter la colonne Q qui correspond à remplacement et si oui comment faire

Merci par avance

Joyeuses paques

Cordialement

Bonjour MANGO19, Dan , le forum,

A tester...

Cordialement,

Bonjour Xorsankukai,,

désolé pour cette réponse tardive.

un immense merci tout se fonctionne

Bien à vous