Daten aus mehreren Mappen (Tab1) zusammenführen

Forumthread: Daten aus mehreren Mappen (Tab1) zusammenführen

19.01.2014 07:50:59

Constantin

Hallo,
ich möchte Daten aus mehreren Mappen in eine Zieltabelle (strZielDatei) übertragen, jedoch ohne die Quelldateien öffnen zu müssen. Die Daten stehen jeweils in Tabelle1 der Quelldateien im Bereich A10:Z1000 (maximale Zeilenanzahl) und sollen in Tabelle1 der Zieldatei (ab Zeile A2)untereinander eingefügt werden. Es sollen nur Werte übernommen werden (keine Formeln etc.). Entstandene Leerzeilen durch den jeweils abgerufenen Maximalbereich kann ich dann ggf. auch manuell in der Zieldatei (Tabelle 1) mit Filter auf Spalte A löschen. Das Makro soll von der Zieldatei aus gestartet werden.
Beispiel für die Quelldateien:
strQDateien(1) = "C:\Pfad1\Datei01.xlsm" Password1
strQDateien(2) = "C:\Pfad2\Datei02.xlsm" Password2
strQDateien(3) = "C:\Pfad3\Datei03.xlsm" Password3
strQDateien(4) = "C:\Pfad4\Datei04.xlsm" Password4
strQDateien(5) = "C:\Pfad5\Datei05.xlsm" Password5
Ich habe leider noch nichts Passendes finden können, wo mehrere Quelldateien im Makro definiert sind und gleichzeitig die Quelldateien geschlossen bleiben sollen.
Über eure Hilfe würde ich mich freuen.
Grüße, Constantin

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

AW: Daten aus mehreren Mappen (Tab1) zusammenführen

19.01.2014 11:48:50

fcs

Hallo Constantin,
die übliche Methode, die Daten per Formel aus einer geschlossenen Datei auszulesen, ist bei passwortgeschützten Dateien problematisch, da nach Eingabe einer Formel das Passwort eingegeben werden muss. Dieses ist dann nur mit der teils problematischen SendKeys-Methode möglich.
Warum sollen denn die Quelldateien nicht geöffnet werden?
ggf. kann man diese schreibgeschützt und ohne Aktualisierung der Formeln öffnen.
Gruß
Franz

AW: ... schreibgeschützt und ohne Aktualisierung

19.01.2014 13:19:24

Constantin

Hallo Franz,
die Dateien haben nur ein Schreibschutz-Password. Beim Öffnen der Dateien gibt es verschiedene Aktivitäten, z.B. Wegschreiben einer Sicherungskopie etc.. Dies würde ich gern vermeiden. Wenn es unter diesen Bedingungen - schreibgeschützt und ohne Aktualisierung - möglich wäre, dann wäre das super.
Grüße, Constantin

AW: ... schreibgeschützt und ohne Aktualisierung

20.01.2014 03:04:57

fcs

Hallo Constantin,
man kann die Ereignismakros vorübergehend deaktivieren. So ist es kein Problem, die Quelldateien zu öffnen. Wenn die Dateien nur zum Ändern kennwortgeschützt sind, dann werden die Passwörter im Makro nicht benötigt.
Nachfolgend ein entsprechendes Makro.
Gruß
Franz

'Makro in einem allgemeinen Modul
Sub DatenHolen()
Dim strQDateien(1 To 5) As String
Dim intI As Integer, StatusCalc As Long
Dim wksZiel As Worksheet
Dim wkbQuelle As Workbook, wksQuelle As Worksheet
Dim ZeileL As Long, ZeileZ As Long, Zelle As Range
On Error GoTo Fehler
strQDateien(1) = "C:\Pfad1\Datei01.xlsm"
strQDateien(2) = "C:\Pfad2\Datei02.xlsm"
strQDateien(3) = "C:\Pfad3\Datei03.xlsm"
strQDateien(4) = "C:\Pfad4\Datei04.xlsm"
strQDateien(5) = "C:\Pfad5\Datei05.xlsm"
'Makrobremsen lösen
With Application
.ScreenUpdating = False
.EnableEvents = False   'Ereignismakros deaktivieren
StatusCalc = .Calculation
.Calculation = xlCalculationManual
End With
Set wksZiel = ActiveSheet                                 'ggf. Anpassen
ZeileZ = 2                      'Startzeile für das Einfügen der Daten in Zieltabelle
For intI = LBound(strQDateien) To UBound(strQDateien)
'Quelldatei schreibgeschützt öffnen
Set wkbQuelle = Application.Workbooks.Open(Filename:=strQDateien(intI), _
UpdateLinks:=False, ReadOnly:=True)
'Quelltabellenblatt setzen
Set wksQuelle = wkbQuelle.Worksheets(1) 'wkbQuelle.Worksheets("Tabelle1"))
With wksQuelle
'Letzte Zelle mit Daten in einer Zeile ermitteln
Set Zelle = .Cells.Find(what:="*", After:=.Cells(1, 1), LookIn:=xlValues, _
lookat:=xlWhole, searchorder:=xlByRows, searchdirection:=xlPrevious)
If Not Zelle Is Nothing Then
ZeileL = Zelle.Row
If ZeileL >= 10 Then
'zu kopierender Zellbereich, ggf. anpassen
With .Range(.Cells(10, 1), .Cells(ZeileL, 26))
.Copy
'Werte in Zieltabelle kopieren
wksZiel.Cells(ZeileZ, 1).PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False
'nächste Einfügezeile berechnen
ZeileZ = ZeileZ + .Rows.Count
End With
End If
End If
End With
'Quelldatei ohne zu speichern wieder schliessen
wkbQuelle.Close savechanges:=False
Set wkbQuelle = Nothing
Set wksQuelle = Nothing
Next intI
'Fehlerbehandlung
Fehler:
With Err
Select Case .Number
Case 0 'Alles OK
Case Else
MsgBox "Fehler-Nr.: " & .Number & vbLf & .Description, _
vbOKOnly + vbInformation, "Makro: DatenHolen"
If Not wkbQuelle Is Nothing Then wkbQuelle.Close savechanges:=False
End Select
End With
'Makrobremsen wieder zurücksetzen
With Application
.ScreenUpdating = True
.EnableEvents = True
.Calculation = StatusCalc
End With
End Sub

AW: ... läuft perfekt - vielen Dank!!!!

20.01.2014 14:59:57

Constantin

Hallo Franz,
das ist noch besser als in meiner Problembeschreibung. Jetzt habe ich auch gleich die richtige Zeilenanzahl. Klappt wunderbar!
Vielen Dank für dieses Programm.
Grüße, Constantin

Beliebteste Forumthreads (12 Monate)

Daten aus mehreren Mappen (Tab1) zusammenführen

Forumthread: Daten aus mehreren Mappen (Tab1) zusammenführen

4
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Forumthreads zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Daten aus mehreren Mappen (Tab1) zusammenführen

Forumthread: Daten aus mehreren Mappen (Tab1) zusammenführen

4 Beiträge zum Forumthread Beiträge zu diesem Forumthread

Forumthreads zu verwandten Themen

VBA Beispiele zu diesem und ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

4
Beiträge zum Forumthread

Beiträge zu diesem Forumthread