https://www.herber.de/bbs/user/93759.xls
https://www.herber.de/bbs/user/93760.xlsm
Besten Dank für die Hilfe
letztezeile = Sheets("Tabelle1").Cells(Rows.Count, 1).End(xlUp).Row
for i = 3 to letzteZeile
if Sheets("Tabelle1").Cells(i,16).Formular= "=Weekday(Sheets("Tabelle1").Cells(i,5);2)" = 5 _
then
letzteZeile = letzteZeile + 1
Sheets("Tabelle1").Rows(i+1 & ":" & i+1).Insert Shift:=xlDown, CopyOrigin:= _
xlFormatFromLeftOrAbove
end if
next i
Ist ungetestet, sollte aber passen