Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
1460to1464
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 aus mehreren Dateien kopieren VBA

Daten aus mehreren Dateien kopieren VBA
08.12.2015 17:11:40
Andre

Hallo,
mit dem folgenden Makro ziehe ich mir aus mehreren Dateien Daten aus mehreren Zellen.
Wie kann ich es hinbekommen,das ich nicht nur eine Zeile sondern 9 zeilen die untereinander stehen übertrage, dann die nächste Datei öffne, wieder die 9 Zeilen übertrage, usw, bis alle Dateien im Ordner gelesen wurden?

Sub kopieren()
'Makro zum Öffnen aller Dateien eines Zielverzeichnisses
'Die Daten aus den Dateien Rapporte Tabelle1
'werden in Zieldatei (diese Datei)
'die Daten jeder Datei werden in eine eigene Zeile geschrieben
' Variablen deklarieren
Dim datei As String
Dim Pfad As String
Dim i As Integer
i = 4
'Quellordner wird festgelegt
Pfad = getFolderName & "\"
'pfad = "L:.......\"
' Dateien des Quellordners ermitteln
datei = Dir(Pfad)
Application.ScreenUpdating = False
' Schleife, um jede Datei auszulesen
Do While datei <> ""
' Datei öffnen (Pfad wird aus den Variablen pfad und datei zusammengesetzt
Workbooks.Open Filename:=Pfad & datei
' Zählvariable für die Zeilen (je Datei eine neue Zeile)
i = i + 1
' Cells wird wie folgt verwendet Cells(Zeilennummer, Spaltennummer)
' Wenn das Makro in der Zieldatei steht, kann die Datei ThisWorkbook genannt werden.
' Die erste Zahl in der Klammer zeigt die Zeile, die zweite die Spalte
ThisWorkbook.Sheets("Tabelle2").Cells(i, 3) = ActiveWorkbook.Sheets("Tabelle1").Cells( _
67, 22)
ThisWorkbook.Sheets("Tabelle2").Cells(i, 4) = ActiveWorkbook.Sheets("Tabelle1").Cells( _
67, 23)
ThisWorkbook.Sheets("Tabelle2").Cells(i, 5) = ActiveWorkbook.Sheets("Tabelle1").Cells( _
67, 24)
' Datei schließen, ohne Änderungen zu speichern
ActiveWorkbook.Close savechanges:=False
' neue Datei aus dem Ordner lesen
datei = Dir()
' Ende der Schleife
Loop
Application.ScreenUpdating = True
End Sub
Function getFolderName()
Dim AppShell As Object
Dim BrowseDir As Variant
Set AppShell = CreateObject("Shell.Application")
Set BrowseDir = AppShell.BrowseForFolder(0, "Ordner auswählen", &H1000, 17)
On Error Resume Next
getFolderName = BrowseDir.items().Item().Path
On Error GoTo 0
End Function

Besten Dank für die Hilfe
André

5
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Daten aus mehreren Dateien kopieren VBA
08.12.2015 20:49:46
Christian
hallo André
probier mal (ungetestet)
Sub GetData()
Dim wkbSrc As Workbook      ' Quelldatei
Dim wksSrc As Worksheet     ' Tabelle der Quelldatei
Dim strFile As String
Dim strPath As String
Dim i As Long
strPath = getFolderName & "\"
strFile = Dir(strPath)
i = 5
Application.ScreenUpdating = False
With ThisWorkbook.Sheets("Tabelle2")
Do While strFile <> ""
Set wkbSrc = Workbooks.Open(strPath & strFile)
Set wksSrc = wkbSrc.Sheets("Tabelle1")
.Cells(i, 3).Resize(9, 3) = wksSrc.Cells(67, 22).Resize(9, 3).Value
i = i + 10
wkbSrc.Close 0
strFile = Dir()
Loop
End With
Application.ScreenUpdating = True
Set wksSrc = Nothing
Set wkbSrc = Nothing
End Sub
Gruß
Christian

Anzeige
AW: Daten aus mehreren Dateien kopieren VBA
09.12.2015 12:48:25
Andre
Hallo Christian,
sieht auf den ersten Blick gut aus. Werde aber noch genauer testen müssen.
Besten Dank erstmal.
Gruß André

AW: Daten aus mehreren Dateien kopieren VBA
09.12.2015 13:02:02
Andre
Hallo Christian,
ich brauche noch die Zellen B13 und H10 aus der Quelldatei 5 x vor die 9 gleichen Zeilen in der Zieldatei.
Hier steht halt in der Quelltabelle das Datum. Das soll 9 mal untereinander in der Zieldatei angezeigt werden. Ich hoffe dass das verständlich ist
Viele Grüße
André

AW: Daten aus mehreren Dateien kopieren VBA
09.12.2015 14:04:47
Christian
hallo,
so weit ich dich verstanden habe...
... setze nach die Zeile "Set wksSrc = wkbSrc.Sheets("Tabelle1")"
folgende 2 Zeilen:
            .Cells(i, 1).Resize(9) = wksSrc.Cells(13, 2).Value
.Cells(i, 2).Resize(9) = wksSrc.Cells(10, 8).Value

Damit übernimmst du die Werte aus B13 nach Spalte A und aus H10 nach Spalte B
Gruß
Christian

Anzeige
AW: Daten aus mehreren Dateien kopieren VBA
10.12.2015 12:10:39
Andre
Super Danke
Klappt bestens
André

309 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige