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
'letzte Zeile mit Daten in Spalte F finden
lngLetzteZeile = .Cells(.Rows.Count, "F").End(xlUp).Row
'Bereich referenzieren
Set rngBereich = .Range(.Cells(23, "G"), .Cells(lngLetzteZeile, "K"))
End With
With rngBereich
'Inhalte der >erste Zeile< im Bereich (heißt NICHT das es Zeile 1 im Blatt sein muss!!)
'auf die unter ihr liegenden übertragen (automatisches Ausfüllen)
Call .Rows(1).AutoFill(Destination:=rngBereich)
End With
Next i
End Sub
Bei der Bestimmungen von lngLetzteZeile befand sich noch ein Fehler (".Row" fehlte am Ende; ist im Code oben nun korrigiert).
rngBereich ist bereits der Datenbereich ab Zeile 23 bis hin zur letzten Zeile. Mit rngBereich.Rows(1) wird also die Zeile 23 referenziert (genauer gesagt der Bereich G23:K23), da diese in diesem Bereich nunmal die erste Zeile ist (die zweite Zeile wäre dann G24:K24 usw.).
Wenn jetzt die erste Zeile (also Zeile 23) die Zeile mit den Spaltenüberschriften ist, die Formeln also eine Zeile tiefer stehen, dann müsste man den Teil des Codes wie folgt abändern.
With rngBereich
'Inhalte der >zweiten Zeile< im Bereich (heißt NICHT das es Zeile 2 im Blatt sein muss!!)
'auf die unter ihr liegenden übertragen (automatisches Ausfüllen)
Call .Rows(2).AutoFill(Destination:=.Worksheet.Range(.Rows(2), .Rows(.Rows.Count)))
End With
PS: Rest des Codes hab ich mir nicht weiter angesehen.
Gruß
|