Live-Forum - Die aktuellen Beiträge
Datum
Titel
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
1456to1460
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

Daten von mehreren Arbeitsmappen in 1 übertragen

Daten von mehreren Arbeitsmappen in 1 übertragen
05.11.2015 17:33:46
mehreren
Hallo ,
Ich bräuchte Hilfe bei Folgendem Problem:
Ich habe 20 Arbeitsmappen in verschiedenen Ordnern auf einem Laufwerk. in jedem der 20 Ordner ist eine Excel Datei mit einem Arbeitsblatt(Tabelle1)
Auf dem Tabellenblatt ist jeweils immer eine Tabelle von Spalte a bis Spalte f.
Diese Tabellen können unterschiedlich viele Daten enthalten.
Momentan löse ich das Problem indem ich einfach in der Zieldatei die Werte eins zu eins per Formel einfüge. Da aber dabei die Listen wie gesagt unterschiedlich lang sind habe ich in der Zieldatei eine Liste die ungefähr 20.000 Zeilen lang ist.
Da später diese Zieldatei in eine Access Datenbank gezogen wird, habe ich dort dann viele leere Zeilen. Ich möchte das nun vermeiden indem eben in den Quelldateien von vorneherein ausgefiltert wird ob die Zelle leer ist oder nicht.
Und das in der Zieldatei nur die Listen drin sind ohne Leerzeilen dazwischen.
Ich denke das würde sich über VBA lösen lassen. Kenne mich aber leider in VBA kaum bis gar nicht aus.
Könnte mir da vielleicht jemand helfen?

1
Beitrag zum Forumthread
Beitrag zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Daten von Arbeitsmappen in 1 übertragen
06.11.2015 09:50:02
Arbeitsmappen
Moin!
du brauchst einen Bereich, in dem die Pfade + Mappen hinterlegt sind.
Dann macht man eine Schleife, die diese Pfade durchgeht und die Daten jeweils in deine Tabelle kopiert
Sub datenimport()
Dim bereich As Range
Dim wb As Workbook
Dim Tabelle As Range
Dim lz As Single
Set bereich = Sheets(2).Range("hier die Adresse mit den Ordern+dateien")
Set wb = ActiveWorkbook
For Each Tabelle In bereich
lz = Sheets(1).Range("A" & Rows.Count).End(xlUp)
Workbooks.Open Tabelle
ActiveWorkbook.Sheets(1).Range("a1:F999").Copy wb.Sheets(1).Range("A" & lz)
ActiveWorkbook.Close 0
Next Tabelle
End Sub
Das ganze ist ungetestet.
viel Erfolg!
Gruß, MCO
Anzeige

301 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige