Re: Zellen auslesen
11.01.2003 00:15:10
Steffan
Hallo Jan,woher kriegst Du denn die Verzeichnisnamen?
Ich bin im Bsp. mal davon ausgegangen dass die in Tabelle1 beginnend in A1 immer schön untereinander stehen.
Dann werden mit dem folgenden Code Deine angegebenen Verzeichnisse durchsucht, die Dateien R*.xls geöffnet (wenns mehrere in dem Verzeichnis gibt werden alle geöffnet), die Werte aus Tabelle1!A1:B1 werden in Deine aktive Tabelle in die A- und B-Spalte untereinander kopiert.
Jetzt musst Du nur noch die jeweiligen Bereiche anpassen, dann sollte es klappen.
Steffan.
Sub openDocs()
Dim oWbk1 As Workbook
Dim oWbk2 As Workbook
Dim oSheet1 As Worksheet 'Tabellenblatt mit Eintragung der Verzeichnisse
Dim oSheet2 As Worksheet 'Tabellenblatt in das die Werte kopiert werden
Dim oSheet3 As Worksheet 'Tabellenblatt aus dem die Werte kommen
Application.ScreenUpdating = False
Set oWbk1 = ActiveWorkbook
Set oSheet1 = oWbk1.Worksheets("Tabelle1")
Set oSheet2 = oWbk1.Worksheets("Tabelle2")
For i = 1 To oSheet1.Cells(1, 1).CurrentRegion.Rows.Count
verz = oSheet1.Cells(i, 1).Value
On Error GoTo f:
'Fehleranzeige bei falschem Eintrag
ChDrive Left(verz, 1)
ChDir verz
On Error GoTo 0
'Dateinamen suchen und einlesen
With Application.FileSearch
.NewSearch
.LookIn = verz
.Filename = "R*.xls"
.FileType = msoFileTypeExcelWorkbooks
.Execute
For j = 1 To .FoundFiles.Count
Workbooks.Open Filename:=.FoundFiles(j), updatelinks:=False
Set oWbk2 = ActiveWorkbook
Set oSheet3 = oWbk2.Worksheets("Tabelle1")
oSheet3.Range(Cells(1, 1), Cells(1, 2)).Copy
oWbk1.Activate
oSheet2.Paste oSheet2.Cells(i, 1)
oWbk2.Close savechanges:=False
Next j
End With
Next
Application.ScreenUpdating = True
Exit Sub
f:
If Err.Number = 68 Or Err.Number = 76 Then _
MsgBox "Verzeichnis " & verz & " existiert nicht!" & Chr(13) & _
"Programmabbruch", vbCritical, "DateienÖffen"
End Sub