ich bin ein VBA-Anfänger, habe es aber geschafft einen Code zu erstellen, mit dem ich mehrere Dateien auslesen kann und in ein Tabellenblatt schrieben kann. Leider werden die Zahlen nicht richtig übernommen. Bei einigen fehlt einfach mal komplett die Kommatas bei anderen werden die Zahlen mit E+14 angegeben. Habe schon versucht die Zahlen davor in Texte umzuwandeln oder mit mehreren Kommastellen auszustatten, hat leider beides nicht geholfen...
Bin am Ende meiner Googlehilfe, vielen Dank im voraus, Dirk.
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