Mehrere Dateien in Listobject kopieren
11.04.2025 15:13:55
Wildfire
ich habe folgendes Anliegen.
Wir bekommen täglich, wöchentlich, monatlich entsprechende Excel-Dateien zugeschickt (Export-Dateien). Diese müssen wir zusammenfassen und auswerten. Diese Exceldateien sind immer gleich aufgebaut:
- 1 Tabellenblatt (export)
- Zeile 1 sind die Spaltenüberschriften (A1:BW1)
- Zeile 2 die enthaltenen Daten (A2:BW2)
- Diese Daten sind auch nur direkt im Tabellenblatt eingetragen nicht in einer intelligenten Tabelle (ListObject)
jetzt habe ich eine weitere Exceldatei zur Auswertung, in der ich per VBA die ganzen zugeschickten Dateien in eine intelligente Tabelle (Listobject) auf dem Tabellenblatt "Import" zusammenfassen möchten:
1. Dateiauswahldialog öffnen um 1 bzw x der zugeschickten Export-Dateien auswählen kann
2. dann ausschließlich jeweils die 2. Zeile aus der jeweiligen EXPORT-Datei in die intelligente Tabelle (Listobject) auf dem Tabellenblatt IMPORT anhängen
3. Duplikate sollen dann entfernt werden (RemoveDuplicates), hierfür gilt Spalte A als eindeutiger Wert
Das Script wird in der Auswertedatei per Schaltfläche ausgeführt.
Ich habe es bisher immer nur in eine nicht intelligente Tabelle, also normales Tabellenblatt eingefügt, für die Weiterverarbeitung birgt dies jedoch mittlerweile viele Probleme.
Wie kann ich das bestehende Script entsprechend umbauen? Bitte nicht gleich steinigen wenn der Code totale Grütze ist. Ich lerne noch :D Ist halt viel zusammenkopiert.
Hier das jetzige Script:
Sub Daten_zusammenfassen()
Dim WBnew As Variant
Dim ws As Worksheet 'Ziel Tabellenblatt Import
Dim intDatei As Long
Dim WBN As Workbook
Dim WSN As Worksheet 'Quell Tabellenblatt export der jeweils ausgewählten Datei
Dim intLZ As Integer
Dim intLZnew As Integer
Set ws = ThisWorkbook.Sheets(1) ' hier werden die Daten hin importiert
WBnew = Application.GetOpenFilename("Excel Dateien (*.xls),*.xls", , "XLS", "Auswahl", True) _
' Mehrfachauswahl der Quelldateien
If TypeName(WBnew) Like "Boolean" Then
MsgBox "Keine Datei ausgewählt!", vbInformation
Exit Sub
Else
Application.ScreenUpdating = False
Application.DisplayAlerts = False
For intDatei = 1 To UBound(WBnew)
Debug.Print WBnew(intDatei)
Set WBN = Workbooks.Open(WBnew(intDatei))
With WBN
Set WSN = WBN.Sheets("export")
intLZ = ws.Cells(Rows.Count, 1).End(xlUp).Row + 1
intLZnew = WSN.Cells(Rows.Count, 1).End(xlUp).Row
WSN.Range("A2:BW" & intLZnew).Copy
ws.Cells(intLZ, 1).PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False
ws.Range("A:BW").RemoveDuplicates Columns:=1, Header:=xlYes
Set WSN = Nothing
.Close False
End With
Set WBN = Nothing
Next intDatei
' aktuelles Datum in die Zelle C14 Tabellenblatt Übersicht, schreiben als Stand des letzten Imports
Range("Stand") = Format(Now, "dd.MM.yyyy")
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End If
Set ws = Nothing
MsgBox "Der Import wurde abgeschlossen!"
End Subund als 2. Frage wie könnte ich hingehen und ggf. den Inhalt, des ListObject löschen. Mit databodyrange.clear löscht er ja nur den Inhalt, wie lösche ich sämtliche Zeile aus der DataBodyRange. Das Listobject soll aber weiter bestehen bleiben.
Bei der Auswertedatei ist die Tabelle noch NICHT als intelligente Tabelle konvertiert. So wie es dort jetzt ist funktioniert das Script auch.
Hier der Link zur hochgeladenen Beispieldatei bzw zum ZIP-File (Auswertedatei und export enthalten): https://www.herber.de/bbs/user/176698.zip
Ich hoffe ich habe nichts vergessen zu beschreiben.
Vielen Dank schonmal für eure Hilfe
LG
TC
Anzeige