Sub Betraege_uebertragen()
Sheets("Berechnung").Select
Application.ScreenUpdating = False
Range("cd148:cd174").Select
Selection.Copy
Windows("Daten DSM.xls").Activate
Sheets(1).Select
Range("A2").Select
For Each Cell In Range("A2:B9")
If ActiveCell "" Then
ActiveCell(Selection.Rows.Count + 1, 1).Select
End If
Next
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=True
Application.CutCopyMode = False
Range("B2").Select
Sheets(1).Select
End Sub
Gruß Willi
Option Explicit ' immer zu empfehlen
Sub Betraege_uebertragen1()
Dim lngZ As Long
Sheets("Berechnung").Range("cd148:cd174").Copy
Workbooks("Daten DSM.xls").Activate
Sheets(1).Select
lngZ = Cells(Rows.Count, 1).End(xlUp).Row + 1
Cells(lngZ, 1).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=True
Application.CutCopyMode = False
Range("B2").Select
End Sub
Sub Betraege_uebertragen2()
Dim lngZ As Long
With ActiveWorkbook
Workbooks("Daten DSM.xls").Activate
Sheets(1).Select
lngZ = Cells(Rows.Count, 1).End(xlUp).Row + 1
Range(Cells(lngZ, 1), Cells(lngZ, 1 + 174 - 148)) = _
Application.Transpose(.Sheets("Berechnung").Range("cd148:cd174").Value)
Range("B2").Select
End With
End Sub
Rückmeldung wäre nett! - Grüße von Erich aus Kamp-Lintfort
Sub Betraege_uebertragen3()
Dim lngZ As Long
With ActiveWorkbook
Workbooks("Daten DSM.xls").Activate
Sheets(1).Select
lngZ = Application.Max(Cells(Rows.Count, 1).End(xlUp).Row, _
Cells(Rows.Count, 2).End(xlUp).Row) + 1
Range(Cells(lngZ, 1), Cells(lngZ, 1 + 174 - 148)) = _
Application.Transpose(.Sheets("Berechnung").Range("cd148:cd174").Value)
Range("B2").Select
End With
End Sub
Rückmeldung wäre nett! - Grüße von Erich aus Kamp-Lintfort