VBA, Zahlen werden nicht richtig übernommen.

Sub Sortiermakro()
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Dim Path1 As String
Dim Path2 As String
Dim Suffix As String
Dim Datei As String
Dim ws As Worksheet
Dim x As Integer
Dim s As Integer
Worksheets.Add(After:=Worksheets(Worksheets.Count)).Name = "Sortierung"
Path1 = ActiveWorkbook.Worksheets("Tabelle1").Range("E6").Value
Path2 = Path1 & "\"
Suffix = "*.csv"
x = -7
If Path2 = "" Then
Exit Sub
Else
Datei = Dir(Path2 + Suffix)
Do While Len(Datei) > 0
x = x + 10
Workbooks.Open Filename:=Path2 & Datei
'Schneiden
Rows("2:43").Select
Selection.Delete Shift:=xlUp
ActiveWindow.SmallScroll Down:=-21
'Mittelwert
Range("B7").Select
ActiveCell.FormulaR1C1 = "Mittelwert:"
Range("C7").Select
ActiveCell.FormulaR1C1 = "=AVERAGE(R[-4]C:R[-2]C)"
Range("C7").Select
Selection.AutoFill Destination:=Range("C7:BT7"), Type:=xlFillDefault
Range("C7:BT7").Select
'Textformat bringen
Cells.Select
Selection.NumberFormat = "@"
Range("A1:BT7").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Workbooks("Makro_Einsortieren_tec5textdatei_zu_excel").Activate
Workbooks("Makro_Einsortieren_tec5textdatei_zu_excel").Worksheets("Sortierung").Select
Range("A1").Select
ActiveCell.Offset(x, 0).Select
ActiveCell.PasteSpecial Paste:=xlPasteValuesAndNumberFormats
Workbooks(Datei).Close SaveChanges:=False
Datei = Dir()
Loop
End If
Rows("1:3").EntireRow.Delete
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub
Sub Schneiden()
Rows("2:43").Select
Selection.Delete Shift:=xlUp
ActiveWindow.SmallScroll Down:=-21
End Sub