Daten in mehrere Arbeitsblätter kopieren

Sub schieben1()
Dim R As Long
R = Me.Shapes(Application.Caller).TopLeftCell.Row
Select Case Left(Cells(R, 13).Text, 1)
Case 1: kopieren "Montag", "D" & R
End Select
End Sub
Private Sub kopieren(Stock As String, Zellen As String)
Dim lngLZ As Long, Ws As Worksheet
Set Ws = Sheets(Stock)
lngLZ = Ws.Cells(Ws.Rows.Count, 1).End(xlUp).Row + 1
Sheets("Übersicht").Range(Zellen).Copy Ws.Cells(lngLZ, 1)
Set Ws = Nothing
End Sub

Kann mir jemand sagen, wie ich das Makro ändern muss, damit der Wert gleichzeitig auch auf die Blätter Dienstag bis Freitag kopiert wird?
Danke und Gruss
Ben