Hallo Ronny,
mit dem nachfolgenden Makro sollte der Import funktionieren.
Deine CSV-Dateien enthalten Text-Daten im Unicode (UTF-8) Format.
Deshalb das Problem mit Umlauten.
Es gibt aber auch Probleme mit Zahlen,3 Nachkommastelen haben. Hier wird das Komma bei deinem gewählten Weg des Datenimports als 100er-Zeichen interpretiert.
LG
Franz
Sub Import_CSV_Data()
' Get_CSV_Data Makro
Dim wkbCSV As Workbook, wksCSV As Worksheet
Dim strCSV As String
Dim strSheet As String
Dim wkbZiel As Workbook
Dim wksZiel As Worksheet
Dim lngZeile_Z As Long
Dim strArchiv As String
Dim strFolder As String
Set wkbZiel = ActiveWorkbook
'Verzeichnis mit CSV-Dateien
strFolder = wkbZiel.Path 'ggf. anpassen
If Dir(strFolder, vbDirectory) = "" Then
MsgBox "Das Verzeichnis " & vbLf & vbLf & strFolder & vbLf & vbLf & "existiert nicht!", _
_
vbInformation + vbOKOnly, _
"Verzeichnis mit den CSV-Dateien"
Exit Sub
End If
'Verzeichnis in das die CSV-Dateien verschoben werden sollen
strArchiv = strFolder & Application.PathSeparator & "CSV_Archiv" 'ggf. anpassen
If Dir(strArchiv, vbDirectory) = "" Then
MsgBox "Das Verzeichnis " & vbLf & vbLf & strArchiv & vbLf & vbLf & "existiert nicht!", _
_
vbInformation + vbOKOnly, _
"Verzeichnis in das CSV-Dateien verschoben werden sollen"
Exit Sub
End If
'CSV-Dateien suchen
strCSV = Dir(strFolder & Application.PathSeparator & "*.csv", vbNormal)
Application.ScreenUpdating = False
' 'gefundene CSV-Dateien abarbeiten
Do Until strCSV = ""
strCSV = strFolder & Application.PathSeparator & strCSV
'CSV-Datei als neue Mappe öffnen - Unicode (UTF-8)
Workbooks.OpenText Filename:=strCSV, _
Origin:=65001, _
StartRow:=2, _
DataType:=xlDelimited, TextQualifier:=xlDoubleQuote, _
ConsecutiveDelimiter:=False, _
Tab:=False, Semicolon:=True, Comma:=False, Space:=False, Other:=False, _
FieldInfo:=Array(Array(1, 2), Array(2, 2), Array(3, 2), Array(4, 1), Array(5, 1), _
Array(6, 2), Array(7, 4), Array(8, 1), Array(9, 1), _
Array(10, 1), Array(11, 1), Array(12, 1), Array(13, 1), Array(14, 1), Array(15, _
1), _
Array(16, 1), Array(17, 1), Array(18, 4), Array(19, 1), Array(20, 1), Array(21, _
1)), _
DecimalSeparator:=",", ThousandsSeparator:=".", TrailingMinusNumbers:=False
Set wkbCSV = ActiveWorkbook
Set wksCSV = wkbCSV.Sheets(1)
'Ziel-Blatt setzen
strSheet = wksCSV.Range("A1").Text
Set wksZiel = wkbZiel.Sheets(strSheet)
With wksZiel
lngZeile_Z = .Cells(.Rows.Count, 1).End(xlUp).Row + 1
If lngZeile_Z