Hallo Sina,
nachfolgend Dein Makro etwas abgeändert. Die Daten aus der CSV-Datei werden nun in Spalte B eingefügt und in Spalte A wird das Datum der CSV-Datei eingetragen.
Kopiere das Makro in ein StandardModul und starte es z.B. über eine Befehlsschaltfläche.
Teste das Makro aber bitte in einer Testdatei und nicht gleich in Deiner Originaldatei.
Option Explicit
Private Sub csv_Import()
Dim dateiname As String
Dim dateiendung As String
Dim datum1 As String
Dim datum2 As String
Dim intF As Integer
Dim oAF As AutoFilter
Dim i
Dim j
Dim EndY As Integer
Dim datum As String
Dim Datei
Dim n As Integer
Dim Pfad
Dim lngFirstRow As Long
On Error Resume Next
For n = "01" To 100 Step 1
Pfad = ("C:\Testdaten\")
dateiname = Dir(Pfad & "\Test*" & n & ".csv")
lngFirstRow = ActiveSheet.Cells(Rows.Count, 2).End(xlUp).Offset(1, 0).Row
With ActiveSheet.QueryTables.Add(Connection:= _
"TEXT;" & Pfad & dateiname, Destination:=Cells(lngFirstRow, 2)) ' Startzeile in Excel !
.Name = "Prod_Zeit_Daten"
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.TextFilePromptOnRefresh = False
.TextFilePlatform = xlWindows
.TextFileStartRow = 1 'Startzeile aus Orginaldatei !
.TextFileParseType = xlDelimited
.TextFileTextQualifier = xlTextQualifierDoubleQuote
.TextFileConsecutiveDelimiter = False
.TextFileTabDelimiter = False
.TextFileSemicolonDelimiter = True
.TextFileCommaDelimiter = False
.TextFileSpaceDelimiter = False
.TextFileColumnDataTypes = Array(1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, _
1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1)
.TextFileThousandsSeparator = " "
.Refresh BackgroundQuery:=False
End With
'Datum in Spalte A eintragen
Range(Cells(lngFirstRow, 1), Cells(ActiveSheet.Cells(Rows.Count, 2).End(xlUp).Row, 1)) = _
Format(FileDateTime(Pfad & dateiname), "dd.mm.yyyy")
Next
'Doppelte Einträge löschen
ActiveSheet.Range("$A$1:$Z$15000").RemoveDuplicates Columns:=Array(1, 2, 3), Header:=xlNo
End Sub
MfG,
Oliver
[sub]Da hier der einzige Lohn für die Helfer eine Rückmeldung ist, wäre es nett, wenn Du
ein Feedback abgeben könntest, ob der Lösungsvorschlag Dein Problem gelöst hat.[/sub]
