Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
776to780
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
776to780
776to780
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Inhaltsverzeichnis

Makro soll auf alle Ordner im gleichen Verzeichnis

Makro soll auf alle Ordner im gleichen Verzeichnis
30.06.2006 10:18:58
Gordon
Hallo Excel-Profis,
ich habe mit Hilfe dieses Forum ein Makro entwickelt, dass Daten aus allen Excel-Dateien ausliest, die sich im gleichen Verzeichnis befinden und in eine Zieldatei schreibt.
Wer kann mir helfen, dass Makro so abzuändern, dass auch die Dateien in den Ordnern ausgelesen werden, die sich in diesem Verzeichnis befinden?
Man müsste doch nur an der Pfadangabe arbeiten, oder? Ich bekomme es leider nicht hin.
Hier der Code:

Sub Konsolidierung()
'Variablen Definitionen
Dim MySheet As Worksheet ' aktuelles Arbeitsblatt der offenen Ziel-Datei-hier werden die Daten reingeschrieben
Dim strPath As String ' Dateipfad zum Auslesen der Dateien
Dim strFile As String ' Quelldatei
Dim wkbInput, meins As Workbook ' Quell-Arbeitsmappe
Dim wksInput As Worksheet ' Quell-Registerblatt
Dim lngTargetRow As Long ' Zeilenzähler für die Bewertungsinformationen
Dim lRow As Long ' Schleifenzähler
Dim lCol As Long ' Schleifenzähler
Dim delta As Integer
Application.DisplayAlerts = False
delta = 0 'Zaehler um in die nächste Zeile zu schreiben
'Merkt sich die Daten der Zieldatei
Set MySheet = ActiveSheet
Set meins = ActiveWorkbook
strPath = ActiveWorkbook.Path
' Verzeichnis durchgehen und alle Dateien auslesen
strFile = Dir(strPath & "\*.xls")
'Ab hier gibt es Anpassungen !!!
Application.ScreenUpdating = False
Do While strFile <> "" ' Schleife beginnen
If strFile = ActiveWorkbook.Name Then
' Zieldatei natürlich übergehen
Else
' Quelldatei öffnen
' und 1. Registerblatt auswählen
Set wkbInput = Application.Workbooks.Open(strPath & "\" & strFile)
Set wksInput = wkbInput.Worksheets(1) 'Wenn das Quell-Sheet immer das 1. Blatt ist, dann so
' Daten auslesen und in Auswertung kopieren'
MySheet.Cells(6 + delta, 2) = wksInput.Cells(7, 2)  'Wert aus Quell- in Zielzelle übertragen
MySheet.Cells(6 + delta, 3) = wkbInput.Name         'NameQuelldatei in Zieltabelle  eintragen, , ggf. wieder löschen
MySheet.Cells(6 + delta, 4) = wksInput.Cells(11, 2) 'Wert aus Quell- in Zielzelle übertragen
MySheet.Cells(6 + delta, 5) = wksInput.Cells(12, 2) 'Wert aus Quell- in Zielzelle übertragen
MySheet.Cells(6 + delta, 6) = wksInput.Cells(14, 2) 'Wert aus Quell- in Zielzelle übertragen
MySheet.Cells(6 + delta, 7) = wksInput.Cells(15, 2) 'Wert aus Quell- in Zielzelle übertragen
MySheet.Cells(6 + delta, 8) = wksInput.Cells(16, 2) 'Wert aus Quell- in Zielzelle übertragen
MySheet.Cells(6 + delta, 9) = wksInput.Cells(17, 2) 'Wert aus Quell- in Zielzelle übertragen
MySheet.Cells(6 + delta, 10) = wksInput.Cells(20, 2) 'Wert aus Quell- in Zielzelle übertragen
MySheet.Cells(6 + delta, 11) = wksInput.Cells(21, 2) 'Wert aus Quell- in Zielzelle übertragen
MySheet.Cells(6 + delta, 12) = wksInput.Cells(22, 2) 'Wert aus Quell- in Zielzelle übertragen
MySheet.Cells(6 + delta, 13) = wksInput.Cells(24, 2) 'Wert aus Quell- in Zielzelle übertragen
MySheet.Cells(6 + delta, 14) = wksInput.Cells(25, 2) 'Wert aus Quell- in Zielzelle übertragen
MySheet.Cells(6 + delta, 15) = wksInput.Cells(31, 2) 'Wert aus Quell- in Zielzelle übertragen
MySheet.Cells(6 + delta, 16) = wksInput.Cells(32, 2) 'Wert aus Quell- in Zielzelle übertragen
MySheet.Cells(6 + delta, 17) = wksInput.Cells(34, 2) 'Wert aus Quell- in Zielzelle übertragen
MySheet.Cells(6 + delta, 18) = wksInput.Cells(36, 2) 'Wert aus Quell- in Zielzelle übertragen
MySheet.Cells(6 + delta, 19) = wksInput.Cells(38, 2) 'Wert aus Quell- in Zielzelle übertragen
MySheet.Cells(6 + delta, 20) = wksInput.Cells(40, 2) 'Wert aus Quell- in Zielzelle übertragen
MySheet.Cells(6 + delta, 21) = wksInput.Cells(43, 2) 'Wert aus Quell- in Zielzelle übertragen
MySheet.Cells(6 + delta, 22) = wksInput.Cells(48, 2) 'Wert aus Quell- in Zielzelle übertragen
MySheet.Cells(6 + delta, 23) = wksInput.Cells(50, 2) 'Wert aus Quell- in Zielzelle übertragen
MySheet.Cells(6 + delta, 24) = wksInput.Cells(52, 2) 'Wert aus Quell- in Zielzelle übertragen
delta = delta + 1 'Nächste Zeile
' Bis hier CODE zum Auslesen
' Datei schließen
wkbInput.Close
Set wkbInput = Nothing
End If
strFile = Dir ' Nächsten Eintrag abrufen
Loop
Application.ScreenUpdating = True
MsgBox "Daten ausgelesen."
End Sub

1
Beitrag zum Forumthread
Beitrag zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Makro soll auf alle Ordner im gleichen Verzeic
02.07.2006 19:57:09
Gordon
Tatsächlich so schwer? Wer kann mir helfen?
Liebe Grüße
Gordon
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige