Daten einfügen VBA
30.11.2019 09:16:52
Peter
Ich importiere Zellwerte aus unterschiedlichen Exceldateien in eine Tabelle. Dafür verwende ich einen im Internet gefundenen Code, welchen ich etwas angepasst habe. Soweit funktioniert alles bestens. Der Code arbeitet alle Dateien im Verzeichnis ab und listet die entsprechenden Werte in einer Tabelle auf. Es wäre super, wenn man den Code noch so modifizieren könnte, dass er bei erneuter Ausführung die neuen Daten jeweils in der Tabelle nach dem letzten Datensatz anfügt. Ich muss teilweise Dateiwerte aus unterschiedlichen Ordnern einfügen. Momentan würden die bestehenden Werte dann immer überschrieben. Ideal wäre natürlich auch noch, wenn man den abzuarbeitenden Pfad mit den Dateien über ein Dialogfenster auswählen könnte. Nachfolgend der Code:
Private Sub DatenHolen_Click()
Dim strDatei As String, strPfad As String, strTyp As String
Dim wbX As Workbook, wksX As Worksheet, wksN As Worksheet
Dim lngCount As Long
Application.ScreenUpdating = False
strPfad = "C:\Test\" 'Pfad anpassen
strTyp = "xls" 'Dareityp anpassen
Set wksN = ThisWorkbook.Sheets(1) 'Zieltabelle
lngCount = 2 'Startzeile in der Zieltabelle
wksN.Range(wksN.Rows(lngCount), wksN.Rows(wksN.UsedRange.Rows.Count + lngCount)).Delete
strDatei = Dir(strPfad & "\*." & strTyp)
Do Until strDatei = ""
Set wbX = Workbooks.Open(strPfad & "\" & strDatei)
Set wksX = wbX.Sheets(1)
wksN.Cells(lngCount, 1) = wksX.Cells(31, 2)
wksN.Cells(lngCount, 2) = wksX.Cells(2, 2)
wksN.Cells(lngCount, 3) = wksX.Cells(4, 1)
wksN.Cells(lngCount, 4) = wksX.Cells(4, 2)
wksN.Cells(lngCount, 5) = wbX.Name
wksN.Cells(lngCount, 6) = wbX.BuiltinDocumentProperties("Last save time").Value
wksN.Cells(lngCount, 7) = wbX.BuiltinDocumentProperties("Last author").Value
lngCount = lngCount + 1
wbX.Close False
strDatei = Dir
Loop
Application.ScreenUpdating = True
End Sub
Liebe Grüsse
Peter