in 30 Ordner gigt es je ein R*.xls, aus dieser Datei (R*.xls) sollen dann 2 Zellen ausgelesen werden, und in eine Tabelle geschrieben werden.
Hat jemand eine Idee?
Gruß Jan
Gruß 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
Gruß Jan
das passiert bereits! In der Schleife
For j = 1 To .FoundFiles.Count werden allegefundenen R*.xls des Verzeichnisses ausgelesen. Allerdings ist mir ein kleiner Fehler unterlaufen: Es wird noch ein Counter gebraucht der die Zeilenummer ermittelt (es kann ja mehr Dateien als angeegebene Verzeichnisse geben) ,also folgende Änderungen /Ergänzungen:
am Anfang einfügen (hinter Sub ...): counter=1
oSheet2.Paste oSheet2.Cells(i, 1) ersetzen durch:
oSheet2.Paste oSheet2.Cells(counter, 1)
counter=counter +1
Jetzt sollte es klappen.
Steffan.