|
Hallo, die Frage wurde auf Herber.de/forum beantwortet.
Vielen Dank an Werner : Hans
Hier die Lösung:
Sub dateinameneinlesen1()
Dim strPfad As String, strDatnam As String
Dim neueZeile As Long, loLetzte As Long, strTemp, i As Integer
'Erst der Pfad
strPfad = "C:\Recycling\Rechnungen\"
strDatnam = Dir(strPfad & "*.xlsm")
'ersteZeile für das Ergebnis
neueZeile = 6
'alte Daten löschen
Rows(neueZeile).CurrentRegion.Rows.Delete Shift:=xlUp
Do While Len(strDatnam)
'Dateinamen (ohne Endung und €-Zeichen) aufteilen, _
Trennzeichen ist " - "
strTemp = Split(Left(strDatnam, Len(strDatnam) - 6), " - ")
'Prüfen ob Datei mit angegebenen Datum übereinstimmt
If strTemp(1) = Format(Range("A1"), "dd.mm.yyyy") Then
'Daten eintragen:
For i = 0 To UBound(strTemp) - 1
Cells(neueZeile, i + 1) = strTemp(i)
Next
Cells(neueZeile, i + 1) = CCur(strTemp(i))
Cells(neueZeile, i + 1).Style = "Currency"
neueZeile = neueZeile + 1
End If
strDatnam = Dir
Loop
loLetzte = Cells(Rows.Count, 7).End(xlUp).Row
Cells(loLetzte + 1, 8) = WorksheetFunction.Sum(Range(Cells(6, 8), Cells(loLetzte, 8)))
Cells(loLetzte + 1, 7) = "Summe"
End Sub
|