Ich habe ein Makro welches mir xls. Dateien einliest und an eine bestimmte Stelle kopiert. Leider steigen wir derzeit auf das CSV Format um. Daher brauche ich eine Möglichkeit CSV Dateien einzulesen und diese dann in ein anständiges Format umzuwandeln. Das derzeitige Einfügen der CSV Daten in Excel geschieht ganz normal über die dafür vorgesehene Funktion in Excel (Daten -> externe Daten aus Text). Hier trenne ich die Zeichen durch "Komma".
Leider habe ich zu wenig Erfahrung in VBA. Der nachfolgende Code ist mein Meisterwerk ;-)
Das Ziel ist es eine CSV Datei einzulesen und diese dann nach Komma getrennt an eine bestimmte Stelle einzufügen.
Dim sheetname
Dim Filename
Dim ritnr
Sub xls_einlesen_und_kopieren()
uitwerkingnaam = (Application.ActiveWorkbook.Name)
anotherfile = vbYes
Do Until anotherfile = vbNo
ritnr = InputBox("Bitte Nummer des Messvorgangs eingeben (Bsp: Messung 1 = 1)", ritnr)
Filename = Application.GetOpenFilename("XLS files (*.xls), *.xls")
If Filename = "" Then
teller = 0
Do Until teller = 2
teller2 = teller + 1
MsgBox "you must select an xls file"
Filename = Application.GetOpenFilename("XLS files (*.xls), *.xls")
Loop
Else
Workbooks.Open Filename:=Filename
End If
'Messdaten befinden sich immer auf "Tabelle1" in der Excel mit den Messdaten
sheetname = "Tabelle1"
'Meldung des Zwischenspeichers ausblenden
Application.DisplayAlerts = False
Worksheets(sheetname).Range("A1:G55").Copy
bandnaam = (Application.ActiveWorkbook.Name)
Windows(bandnaam).Close
Windows(uitwerkingnaam).Activate
'Aufteilung der eingelesenen Daten in den dafür vorgesehenen Bereich
If ritnr = 1 Then
ActiveSheet.Paste Destination:=Worksheets("Datenblatt").Range("B10")
Worksheets("Datenblatt").Activate
Worksheets("Datenblatt").Range("A10").Select
Selection.Formula = bandnaam
End If
If ritnr = 2 Then
ActiveSheet.Paste Destination:=Worksheets("Datenblatt").Range("B70")
Worksheets("Datenblatt").Activate
Worksheets("Datenblatt").Range("A70").Select
Selection.Formula = bandnaam
End If
If ritnr = 3 Then
ActiveSheet.Paste Destination:=Worksheets("Datenblatt").Range("B130")
Worksheets("Datenblatt").Activate
Worksheets("Datenblatt").Range("A130").Select
Selection.Formula = bandnaam
End If
If ritnr = 4 Then
ActiveSheet.Paste Destination:=Worksheets("Datenblatt").Range("B190")
Worksheets("Datenblatt").Activate
Worksheets("Datenblatt").Range("A190").Select
Selection.Formula = bandnaam
End If
If ritnr = 5 Then
ActiveSheet.Paste Destination:=Worksheets("Datenblatt").Range("B250")
Worksheets("Datenblatt").Activate
Worksheets("Datenblatt").Range("A250").Select
Selection.Formula = bandnaam
End If
If ritnr = 6 Then
ActiveSheet.Paste Destination:=Worksheets("Datenblatt").Range("B310")
Worksheets("Datenblatt").Activate
Worksheets("Datenblatt").Range("A310").Select
Selection.Formula = bandnaam
End If
If ritnr = 7 Then
ActiveSheet.Paste Destination:=Worksheets("Datenblatt").Range("B370")
Worksheets("Datenblatt").Activate
Worksheets("Datenblatt").Range("A370").Select
Selection.Formula = bandnaam
End If
If ritnr = 8 Then
ActiveSheet.Paste Destination:=Worksheets("Datenblatt").Range("B430")
Worksheets("Datenblatt").Activate
Worksheets("Datenblatt").Range("A430").Select
Selection.Formula = bandnaam
End If
If ritnr = 9 Then
ActiveSheet.Paste Destination:=Worksheets("Datenblatt").Range("B490")
Worksheets("Datenblatt").Activate
Worksheets("Datenblatt").Range("A490").Select
Selection.Formula = bandnaam
End If
'Meldung des Zwischenspeichers einblenden
Application.DisplayAlerts = True
Worksheets("Home").Activate
Worksheets("Home").Range("B18").Select
anotherfile = MsgBox("Möchten sie einen weiteren Satz hinzufügen?", vbYesNo)
Loop
End
Sub