|
Hallo,
ich habe ein Problem. Ich möchte aus einer Tabelle bestimmte Zellen pro Spalte (von Zeile 15 bis zu letzt benutzten Zeile) an das Ende einer anderen Tabelle kopieren.
Eigentlich sind es mehrere Spalten aber ich scheitere schon eine zu kopieren. Das war mein
Versuch und es führt zu einen Laufzeitfehler 13. Das ganze sieht im Moment so aus:
Sub KopiereBereich()
Dim Quelltab As Worksheet
Dim Zieltab As Worksheet
Dim Zelle As Range
Dim Zaehler As Long
Set Zieltab = ActiveWorkbook.Worksheets("Test")
Dim I As Long
Dim J As Long
Dim LetzteZeileZieltab As Long
Dim LetzteZeileQuelltab As Long
'On Error GoTo Fehlerbehandlung
'Daten der Anlage übernehmen
For I = 5 To Worksheets.Count
If Worksheets(I).Cells(1, 3).Value <> "" Then
LetzteZeileZieltab = Zieltab.Cells(Rows.Count, 2).End(xlUp).Row
LetzteZeileZieltab = LetzteZeileZieltab + 1
Worksheets(I).Range("C1:C13").Copy
Zieltab.Cells(LetzteZeileZieltab, 2).PasteSpecial Transpose:=True
Application.CutCopyMode = False
LetzteZeileQuelltab = Worksheets(I).Cells(Rows.Count, 2).End(xlUp).Row
'For J = 15 To LetzteZeileQuelltab
Worksheets(I).Range(Cells(J, 1), Cells(LetzteZeileQuelltab, 1)).Copy _
Destination:=Worksheets(Zieltab).Range(Cells(LetzteZeileZieltab, 16), Cells(LetzteZeileQuelltab _
LetzteZeileZieltab + 1, 16))
', (Range("K" & J & ":K" & LetzteZeileQuelltab))).Select
'Worksheets(Zieltab).Cells("O" & LetzteZeileZieltab).Select
'Worksheet(Zieltab).Range(.Cells(LetzteZeileZieltab, 16), .Cells( _
LetzteZeileZieltab + LetzteZeileQuelltab, 16)).Paste
'LetzteZeileQuelltab = LetzteZeileQuelltab + 1
'Next J
End If
Next I
Fehlerbehandlung:
End Sub
Der Fehler kommt an der Zeile: Worksheets(I).Range(Cells(J, 1), Cells(LetzteZeileQuelltab, 1)).Copy Destination:=Worksheets(Zieltab).Range(Cells(LetzteZeileZieltab, 16), Cells(LetzteZeileQuelltab + LetzteZeileZieltab + 1, 16))
Über HIlfe wäre ich super dankbar
|