Application.GetOpenFilename Ersatz für Ordnerwahl
31.08.2006 14:30:57
Picasso
Kann mir bitte jemand helfen.
Habe ein fertiges Makro gebastelt, womit ich Daten aus anderen Arbeitsmappen einlesen kann.
Die Wahl dieser Dateien erfolgt mit Application.GetOpenFilename.
Jetzt möchte ich aber, dass ich einfach einen Ordner auswähle und das Makro die Unterordner bzw. die darin enthaltenen Excel-Sheets bearbeitet.
Habe einige Codes in diesem Forum gefunden, kriege es aber nicht gebacken, diese in meinem Code mit einzubauen.
Anbei die Beispielmappe
https://www.herber.de/bbs/user/36315.xls
bzw. der mir vorliegende Code:
Public
Sub Datenkonsolidieren()
On Error GoTo Fehler
'Erst säubern
Range("A4").Select
Range(Selection, Selection.End(xlToRight)).Select
Range(Selection, Selection.End(xlDown)).Select
Selection.ClearContents
Range("A4").Select
'Dann gehts los
DieseDatei = ActiveWorkbook.Name
dateiliste = Application.GetOpenFilename("Microsoft Excel-Dateien (*.xls), *.xls", , "Bitte wählen Sie die Dateien aus, die eingelesen werden sollen!", , True)
For Each Vardatei In dateiliste
Workbooks.Open Filename:=Vardatei
GeladeneDatei = ActiveWorkbook.Name
Call Einlesen(DieseDatei, GeladeneDatei)
Next Vardatei
Range("A4").Select
MsgBox "Daten erfolgreich eingelesen!"
Exit Sub
Fehler:
MsgBox "Fehler! Das Programm wird abgebrochen"
Exit Sub
End Sub
Public
Sub Einlesen(DieseDatei, GeladeneDatei)
On Error GoTo Fehler
Windows(GeladeneDatei).Activate
ActiveSheet.Unprotect Password:="pizza"
a = Range("A35").Value
b = Range("B35").Value
c = Range("C35").Value
d = Range("D35").Value
e = Range("E35").Value
f = Range("F35").Value
g = Range("G35").Value
h = Range("H35").Value
i = Range("I35").Value
j = Range("J35").Value
k = Range("K35").Value
l = Range("M29").Value
m = Range("N29").Value
n = Range("O29").Value
o = Range("P29").Value
p = Range("Q29").Value
q = Range("U29").Value
r = Range("V29").Value
s = Range("X29").Value
Application.DisplayAlerts = False
ThisWorkbook.Saved = True
Workbooks(GeladeneDatei).Close
Application.DisplayAlerts = True
Windows(DieseDatei).Activate
ActiveCell = a
ActiveCell.Offset(0, 1).Range("A1").Select
ActiveCell = b
ActiveCell.Offset(0, 1).Range("A1").Select
ActiveCell = c
ActiveCell.Offset(0, 1).Range("A1").Select
ActiveCell = d
ActiveCell.Offset(0, 1).Range("A1").Select
ActiveCell = e
ActiveCell.Offset(0, 1).Range("A1").Select
ActiveCell = f
ActiveCell.Offset(0, 1).Range("A1").Select
ActiveCell = g
ActiveCell.Offset(0, 1).Range("A1").Select
ActiveCell = h
ActiveCell.Offset(0, 1).Range("A1").Select
ActiveCell = i
ActiveCell.Offset(0, 1).Range("A1").Select
ActiveCell = j
ActiveCell.Offset(0, 1).Range("A1").Select
ActiveCell = k
ActiveCell.Offset(0, 1).Range("A1").Select
ActiveCell = l
ActiveCell.Offset(0, 1).Range("A1").Select
ActiveCell = m
ActiveCell.Offset(0, 1).Range("A1").Select
ActiveCell = n
ActiveCell.Offset(0, 1).Range("A1").Select
ActiveCell = o
ActiveCell.Offset(0, 1).Range("A1").Select
ActiveCell = p
ActiveCell.Offset(0, 1).Range("A1").Select
ActiveCell = q
ActiveCell.Offset(0, 1).Range("A1").Select
ActiveCell = r
ActiveCell.Offset(0, 1).Range("A1").Select
ActiveCell = s
ActiveCell.Offset(1, -18).Range("A1").Select
Exit Sub
Fehler:
MsgBox "Einlesefehler!"
Exit Sub
End Sub
Vielen Dank für eure Hilfe!
Grüße
Picasso