Daten übertragen

Sub Daten_kopieren()
Dim arrTemp
Dim arrDaten()
Dim lngRows As Long
Dim lngColumns As Long
Dim lngCounter As Long
Application.ScreenUpdating = False
Application.EnableEvents = False
With Worksheets("BES-Kosten")
intLastRow = .Cells(Rows.Count, 1).End(xlUp).Row - 1
intLastColumn = .Cells(1, Columns.Count).End(xlToLeft).Column
lngCounter = 0
arrTemp = .Range(.Cells(1, 1), .Cells(intLastRow, intLastColumn))
ReDim arrDaten(1 To UBound(arrTemp, 2), 1 To UBound(arrTemp))
For lngRows = 10 To UBound(arrTemp)
lngCounter = lngCounter + 1
For lngColumns = 1 To UBound(arrTemp, 2)
arrDaten(lngColumns, lngCounter) = arrTemp(lngRows, lngColumns) 'Daten aus Spalte 1  _
bis 48
Next lngColumns
Next lngRows
If lngCounter = 0 Then
MsgBox prompt:="Keine Übereinstimmung gefunden" _
& vbNewLine & vbNewLine & "Die Ausführung wird beendet", _
Title:="    Mitteilung an " & Application.UserName
Worksheets("BES-Kosten neu").Delete
End
End If
ReDim Preserve arrDaten(1 To UBound(arrDaten), 1 To lngCounter)
Sheets("BES-Kosten neu").Cells(1, 1).Resize(lngCounter, UBound(arrDaten)) =  _
WorksheetFunction.Transpose(arrDaten)
End With
Application.ScreenUpdating = True
Application.EnableEvents = True
End Sub