AW: Daten aus einem Ordner mit Excel Datein
05.03.2020 13:00:18
Rudi
Hallo,
könnte so aussehen.
In den Tagesberichten Auftragsnummer ab A2, Zeit ab C2
Ausgabe in Blatt 'Aufträge'
Sub Import_Auftraege()
Dim objAuftrag As Object, rngC As Range, wkbTag As Workbook
Dim strPfad As String, strFile As String
Application.ScreenUpdating = False
strPfad = ThisWorkbook.Path & "\"
Set objAuftrag = CreateObject("scripting.dictionary")
objAuftrag("Auftrag") = "Zeit" 'für die Überschrift
strFile = Dir(strPfad & "*.xlsx")
Do While Len(strFile)
Set wkbTag = Workbooks.Open(strPfad & strFile)
With wkbTag.Sheets(1)
For Each rngC In .Range(.Cells(2, 1), .Cells(Rows.Count, 1).End(xlUp))
If objAuftrag.exists(rngC.Value) Then
objAuftrag(rngC.Value) = objAuftrag(rngC.Value) + rngC.Offset(, 2) * 1
Else
objAuftrag(rngC.Value) = rngC.Offset(, 2) * 1
End If
Next rngC
End With
wkbTag.Close False
strFile = Dir
Loop
'Daten in Blatt "Aufträge" schreiben
With Sheets("Aufträge")
.Cells.ClearContents 'löschen
.Cells(1, 1).Resize(objAuftrag.Count) = Application.Transpose(objAuftrag.keys) 'Aufträge
.Cells(1, 2).Resize(objAuftrag.Count) = Application.Transpose(objAuftrag.items) 'Zeit
End With
End Sub
Gruß
Rudi