Werte mittels VBA auslesen

Hallo zusammen,
möchte Euch bei folgender Thematik um Eure Hilfe bitten:
Habe ein Verzeichnis mit ca. 150 Excel Dateien, die alle gleich aufgebaut sind.
Jede Datei hat mehrere Tabellenblätter, die je Datei aber gleich benannt sind und auch gleich aufgebaut sind. Aus diesen vielen Dateien möchte ich nun eine Datei, die drei bestimmte Werte aus den 150 Dateien ausliest.
Dabei sind zwei Werte in fixen Zellen. Eine eindeutige Nummer in Zelle A2 und ein errechneter Wert in Zelle B5, beide im ersten Tabellenblatt (wobei diese Werte auch in allen anderen Tabellenblättern sind). Der dritte Wert befindet sich in einem Tabellenblatt mit dem Namen "Jahr 2010". Der Wert befindet sich vier Zellen rechts von einem Datum "01.12.2010".
Die neue Tabelle sollte also so aussehen (von A - C):
Eindeutige Nummer; errechneter Wert; Wert neben Datum 01.12.2010 aus bestimmten Tabellenblatt.
Muss dazu sagen das ich mich mit Makros so gut wie gar nicht auskenne. Leider weiß ich aber keinen anderen Weg.
Vielen Dank für Eure Hilfe!
Gruß
Dustbin

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Benutzer

Hallo,
mit vba vllt. so:
in einer neuen Arbeitsmappe ein neues VBA-Modul einfügen (alt+F11; Einfügen Modul),
den folgenden Code hineinkopieren und an den markierten Stellen anpassen

Sub schreibe_in_Datei()
Dim i As Integer
fName = Dir("C:\Temp\*.xls") 'den Pfad musst Du anpassen!!!
Call newRecord(fName)
Do
fName = Dir
Call newRecord(fName)
Loop While fName  ""
End Sub

Sub newRecord(fName)
If fName = ThisWorkbook.Name Or fName = "" Then
Exit Sub
End If
Dim ab As Workbook
Dim sh As Worksheet
Dim c As Object
Dim ze As Long
Dim fPath
Set wb = ThisWorkbook
Set sh = wb.Sheets("Tabelle1")
fPath = "C:\Temp\" 'Den Pfad musst Du anpassen (so wie schon oben)
ze = sh.[A65536].End(xlUp).Row + 1
Workbooks.Open Filename:=fPath & fName
w1 = Sheets(1).[A2]
w2 = Sheets(1).[B5]
Set c = Sheets(1).Cells.Find(What:=CDate("01.12.2010"), _
After:=Range("A1"), LookIn:=xlFormulas, LookAt:=xlWhole, _
SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False)
On Error GoTo fb_find
w3 = Cells(c.Row, c.Column + 4)
ActiveWorkbook.Close savechanges:=False
sh.Cells(ze, 1) = w1
sh.Cells(ze, 2) = w2
sh.Cells(ze, 3) = w3
Exit Sub
fb_find:
If Err = 91 Then
Resume Next
Else
MsgBox "Fehler Nr. " & Err & " ist aufgetreten:" & vbCr & Error
End If
End Sub

Jochen

Beliebteste Forumthreads (12 Monate)

3
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

18 Forumthreads zu ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Werte mittels VBA auslesen

3 Beiträge zum Forumthread Beiträge zu diesem Forumthread

18 Forumthreads zu ähnlichen Themen

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

3
Beiträge zum Forumthread

Beiträge zu diesem Forumthread