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,