.XLS zusammenführen und automatisch löschen
16.11.2018 17:34:52
Tobias
Ich habe den Auftrag bekommen, es zu ermöglichen, dass per Button, alle .xls Dateien in einen bestimmten Ordner zusammengeführt werden können. In diesen .xls Dateien existiert nur eine Zeile(Zeile 1) mit ca. 60 Spalten.
Die Werte sollen tabellarisch untereinander geschrieben werden.
Im Grunde habe ich schon ein ähnliches Script, jedoch öffnet sich hier das Dialogfenster und ich muss manuell die Dateien suchen und hinzufügen.
Ziel wäre, automatisch alle Dateien in einen festen Ordner zusammenzuführen und diese nach der !erfolgreichen! Zusammenführung gleich automatisch zu löschen.
Hier mal kurz der bestehende Code.
Public Sub Daten_uebertragen()
Option Explicit
Dim strFile As String
Dim objWorkbook As Workbook
Dim objTargetWorksheet As Worksheet
With Application.FileDialog(msoFileDialogFilePicker)
.Title = "Quelldatei auswählen"
.ButtonName = "Datei öffnen"
.AllowMultiSelect = True
If .Show Then
strFile = .SelectedItems(1)
Set objTargetWorksheet = ThisWorkbook.Worksheets(1)
Set objWorkbook = Workbooks.Open( _
Filename:=strFile, UpdateLinks:=0, ReadOnly:=True)
With objWorkbook.Worksheets(1)
.Range(.Cells(2, 1), .Cells(.Rows.Count, 1).End(xlUp).Resize(1, 7)).Copy _
Destination:=objTargetWorksheet.Cells( _
objTargetWorksheet.Rows.Count, 1).End(xlUp).Offset(1, 0)
End With
objWorkbook.Close SaveChanges:=False
Set objTargetWorksheet = Nothing
Set objWorkbook = Nothing
End If
End With
End Sub
Ich wäre sehr dankbar, wenn sich hier vielleicht einer Zeit nimmt und mir helfen kann.
Danke im Voraus
mit freundlichen Grüßen
Tobias