Live-Forum - Die aktuellen Beiträge
Anzeige
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

2 Daten aus mehrern Datein

2 Daten aus mehrern Datein
11.12.2008 09:41:00
Thomas
Hallo liebe Exceler,
habe wieder eine Frage mit der Bitte um Hilfe.
Ich habe eine Datei mit einem (hier im Forum gefundenen) VBA- Code erstellt, wo alle Dateinamen aus einem bestimmten Verzeichnis als Hyperlink eingefügt sind.
Jetzt benötige ich aus jeder der aufgelisteten Links (Datei) zwei Werte aus allen Datein. Wäre die Zelle E2 und S4, die dann mit dem Link in einer Zeile stehen.
Habe leider nichts passendes im Forum gefunden.
Anbei das Bsp.
https://www.herber.de/bbs/user/57539.xls
Vielen vielen Dank im Voraus.
Gruß Thomas

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

Betreff
Datum
Anwender
Anzeige
AW: 2 Daten aus mehrern Datein
11.12.2008 10:42:17
Wenderhold
hi und moin
Option Explicit

Public Sub read_werte()
Dim i As Integer
Dim wb As Workbook
For i = 2 To 12
Set wb = Workbooks.Open(Sheets(1).Cells(i, 1).Value)
Sheets(1).Cells(i, 2).Value = wb.Sheets(1).Cells(2, 5).Value
Sheets(1).Cells(i, 3).Value = wb.Sheets(1).Cells(4, 19).Value
wb.Close
Next i
End Sub


hab das teil aber nicht getestet !!!
greeze
e

AW: 2 Daten aus mehrern Datein
11.12.2008 11:10:32
fcs
Hallo Thomas,
im Prinzip gibt es hier schon so was im Forum.
Problem ist evtl. den dateinamen im Link für das lesen sauber auszulesen.
Hier mein Vorschlag. Die Daten werden dabei aus dem jeweils 1. Tabellenblatt der Datei uzum Link ausgelesen.
gruß
Franz

Sub DatenHolen()
Dim wbQuelle As Workbook, wksQuelle As Worksheet, strQuelle As String
Dim wks As Worksheet, Zeile As Long, ZeileLetzte As Long
Set wks = ActiveWorkbook.Worksheets("Tabelle1")
On Error GoTo Fehler
With wks
ZeileLetzte = .Cells(.Rows.Count, 1).End(xlUp).Row
Application.ScreenUpdating = False
For Zeile = 2 To ZeileLetzte
strQuelle = .Cells(Zeile, 1).Hyperlinks(1).Address
'Prüfung, ob Hyperlink-datei im gleichen Verzeichnis wie aktive Datei.
If InStr(1, strQuelle, Application.PathSeparator) = 0 Then
strQuelle = ActiveWorkbook.Path & Application.PathSeparator & strQuelle
End If
Application.StatusBar = "Datei " & Zeile - 1 & " von " & ZeileLetzte - 1 & ": " _
& strQuelle
Set wbQuelle = Workbooks.Open(Filename:=strQuelle, ReadOnly:=True)
Set wksQuelle = wbQuelle.Worksheets(1)
.Cells(Zeile, 2).Value = wksQuelle.Range("E2").Value
.Cells(Zeile, 3).Value = wksQuelle.Range("S4").Value
wbQuelle.Close savechanges:=False
Resume01:
Next
End With
Fehler:
With Err
If .Number  0 Then
Select Case .Number
Case 1004
MsgBox "Fehler-Nr.: " & .Number & vbLf & .Description & "Datei " & strQuelle _
& " nicht gefunden!"
Resume Resume01
Case Else
MsgBox "Fehler-Nr.: " & .Number & vbLf & .Description
End Select
End If
End With
Application.StatusBar = False
Application.ScreenUpdating = True
MsgBox "Fertig"
End Sub


Anzeige
Das ist ja super genial!!!
11.12.2008 13:17:33
Thomas
Tausend Dank... funktioniert aber sowas von genial.
Danke Thomas...

311 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige