Option Explicit
Sub Copy()
Dim i, j, m As Integer
Dim rngBereich As Excel.Range
Dim lngLetzteZeile As Long
For i = 7 To 7
j = 24
Sheets("Fitting Bond Universe").Range("B24:K300").Value = ""
Sheets("Fitting Bond Universe").Range("B21").Value = Sheets("Daten").Range("A" & i).Value
For m = 2 To 569
If Sheets("Daten").Cells(i, m).Value <> "" Then
Sheets("Fitting Bond Universe").Cells(j, "B").Value = Sheets("Daten").Cells("3", m).Value
Sheets("Fitting Bond Universe").Cells(j, "C").Value = Sheets("Daten").Cells("5", m).Value
Sheets("Fitting Bond Universe").Cells(j, "F").Value = Sheets("Daten").Cells(i, m).Value
j = j + 1
End If
Next m
With ActiveSheet
lngLetzteZeile = .Cells(.Rows.Count, "F").End(xlUp)
Set rngBereich = .Range(.Cells(23, "G"), .Cells(lngLetzteZeile, "K"))
End With
With rngBereich.Rows(23)
Call .AutoFill(Destination:=rngBereich)
End With
Next i
End Sub