nach Datum auslesen
Horst
nachstehendes VBA-Modul liest Daten aus .csv's aus und schreibt sie untereinander. In Zeile D8 wird hierbei nach dem Datum gesucht. Wie müsste ich den Code verändern, damit unabhängig vom in der .csv stehendem Datum der gesamte Inhalt vom Bereich C8:F175 aus den .csv's rauskopiert wird?
Besten Dank vorab!
Sub project()
' Daten aus CSV-Dateien einfügen, Daten sind durch Semicolon getrennt, _
Dezimalstelle ist Punkt
' im aktiven Blatt werden Daten aus CSV Dateien im gewählten Verzeichnis eingefügt
Dim wb As Workbook, wks As Worksheet, wbAktiv As Workbook, wksAktiv As Worksheet
Dim rngZelle As Range
Dim strVerzeichnis As String
Dim Dateiname As Variant, DateinameTXT As String
Const strZelleDatum As String = "d8" 'Zelle mit Datum in CSV-Datei
Const strBereich As String = "C8:F175" 'zu kopierender Bereich in CSV-Datei
Const lngZeilenBereich As Long = 168 'Anzahl Zeilen des kopierten Bereichs in CSV-datei
Dateiname = Application.GetOpenFilename(FileFilter:="CSV (*.csv), *.csv", _
Title:="CSV-Datei im Verzeichnis auswählen")
If Dateiname = False Then Exit Sub
strVerzeichnis = VBA.CurDir
Set wbAktiv = ActiveWorkbook
Set wksAktiv = ActiveSheet
'Nächste freie Zelle in Spalte B (2) am Ende suchen
Set rngZelle = wksAktiv.Cells(Rows.Count, 2).End(xlUp).Offset(1, 0)
Dateiname = Dir(strVerzeichnis & Application.PathSeparator & "*.csv")
Application.ScreenUpdating = False
Do Until Dateiname = ""
'CSV-Datei temporär als txt-Datei kopieren
VBA.FileCopy Source:=Dateiname, Destination:=Left(Dateiname, Len(Dateiname) - 3) & "txt"
DateinameTXT = Left(Dateiname, Len(Dateiname) - 3) & "txt"
'Umbenannte Kopie öffnen
Application.Workbooks.OpenText Filename:=DateinameTXT, Origin:=xlWindows, _
StartRow:=1, _
DataType:=xlDelimited, ConsecutiveDelimiter:=False, _
Tab:=False, _
Semicolon:=True, _
Comma:=False, _
Space:=False, _
Other:=False, _
DecimalSeparator:=".", ThousandsSeparator:=","
Set wb = ActiveWorkbook
'Daten Kopieren
wb.Sheets(1).Range(strBereich).Copy
rngZelle.PasteSpecial Paste:=xlPasteValues
'Datum aus CSV-Datei in Spalte links von den Daten einfügen
wksAktiv.Range(rngZelle.Offset(0, -1), rngZelle.Offset(lngZeilenBereich - 1, -1)).Value _
= wb.Sheets(1).Range(strZelleDatum)
'Nächste Einfügezelle setzen
Set rngZelle = rngZelle.Offset(lngZeilenBereich, 0)
wb.Close savechanges:=False
'TXT-Kopie wieder löschen
VBA.Kill (DateinameTXT)
Dateiname = Dir
Application.DisplayAlerts = False
Loop
Application.ScreenUpdating = True
End Sub