Daten aus geschlossener Arbeitsmappe auslesen

Hallo Excel Freunde,
ich versuche Daten aus geschlossenen Dateien (ganze Bereiche) auszulesen. Wie ich nach Recherchen festgestellt habe gehts zwar mit indirekt, aber nach schließen der Datei ist dann eben eine Fehlermeldung "#Bezug" da. Scheint also nur mit Makro zu gehen. Und da kenne ich mich leider überhaupt nicht aus, nicht einmal wohin genau das Makro gespeichert werden muss (Modul? in der Arbeitsmappe?) Ok wie man da hinkommt das weiß ich (Alt+F11 :)).
Könnt ihr mir da weiter helfen?
Folgender Aufbau:
Es gibt einen Pfad wo die Datei "Auslesen" gespeichert ist. Hier werden aus den verschiedenen Unterordnern der Projekte aus einem File mit gleichem Namen wie der Unterordner Daten ausgelesen. In der Bsp Datei sind die Pfade auch mit angegeben (Spalten B - D, werden aber ausgeblendet). In der Datei habe ich ein Formularsteuerelement eingefügt, ist das überhaupt notwendig?
https://www.herber.de/bbs/user/93379.xlsm
Die Daten gibt der Anwender in der Datei (z. B. 14_001.xls) im Deckblatt ein, ausgelesen werden Sie aber aus einem zweiten Tabellenblatt (Reiter "Projektdaten") wo sie gesammelt hintereinander stehen. Die Datei steht in einem Unterordner (hier Ordner 14_001)
https://www.herber.de/bbs/user/93380.xlsx
Nochmal der Pfadaufbau:
C:\C-TRANSFER\Auslesen geschlossener Dateien - hier steht die Datei "Einlesen"
C:\C-TRANSFER\Auslesen geschlossener Dateien\Projektnummer (BSP: 14_001) - hier steht die Datei "Auslesen" (BSP: 14_001.xls)
Vielen Dank schon mal im Voraus und noch einen schönen Sonntag
Gruß
Raphael

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Hallo Raphael,
das ist aufwendig, ich würde die Datei öffnen

Option Explicit
Public Function GetDataClosedWB(SourcePath As String, _
SourceFile As String, sourceSheet As String, _
SourceRange As String, TargetRange As Range) As Boolean
'Holt einen Bereich aus einer _geschlossenen_ Arbeitsmappe
'Nur in VBA zu verwenden; nicht aus einer Tabellenzelle heraus
'© t.ramel@mvps.org
' wird durch die HoleDaten aufgerufen
Dim strQuelle       As String
Dim Zeilen          As Long
Dim Spalten         As Byte
On Error GoTo InvalidInput
strQuelle = "'" & SourcePath & "[" & SourceFile & "]" & sourceSheet & "'!" & Range( _
SourceRange).Cells(1, 1).Address(0, 0)
Zeilen = Range(SourceRange).Rows.Count
Spalten = Range(SourceRange).Columns.Count
With TargetRange.Cells(1, 1).Resize(Zeilen, Spalten)
.Formula = "=IF(" & strQuelle & "="""",""""," & strQuelle & ")"
.Value = .Value
End With
GetDataClosedWB = True
Exit Function
InvalidInput:
MsgBox "Die Quelldatei oder der Quellbereich ist ungültig!", vbExclamation, "Get data from  _
closed Workbook"
GetDataClosedWB = False
End Function
Public Sub HoleDaten()
' Die Funktion arbeitet mit der obrigen GetDataClosedWB zusammen
Dim Pfad            As String
Dim Dateiname       As String
Dim Blatt           As String
Dim Bereich         As String
Dim Ziel            As Range
Pfad = "L:\Eigene Dateien\Hajo\Internet\Test\2009\"
Dateiname = "Beispiel Forum 30.xlsm" ' aus welcher Datei soll er holen?
Blatt = "Tabelle1"  ' von welcher Tabelle soll er holen?
Bereich = "A1:B9"   ' aus welchem Bereich soll er holen?
Set Ziel = ActiveSheet.Range("A1")  ' in welchen Bereich soll er kopieren? Genauer gesagt:  _
Bei welcher Zelle soll er anfangen, Datein reinzukopieren? Bsp: ActiveCell geht auch
If GetDataClosedWB(Pfad, Dateiname, Blatt, Bereich, Ziel) Then
MsgBox "Daten importiert"
End If
End Sub

Public Sub HoleDaten() ' Die Funktion arbeitet mit der obrigen GetDataClosedWB zusammen Dim Pfad As String Dim Dateiname As String Dim Blatt As String Dim Bereich As String Dim Ziel As Range Pfad = "C:\Test\Projekte\14_001\" Dateiname = "14_001.xlsx" ' aus welcher Datei soll er holen? Blatt = "Datenübertrag" ' von welcher Tabelle soll er holen? Bereich = "A4:AN4" ' aus welchem Bereich soll er holen? Set Ziel = ActiveSheet.Range("F5") ' in welchen Bereich soll er kopieren? Genauer _ gesagt: _ Bei welcher Zelle soll er anfangen, Datein reinzukopieren? Bsp: ActiveCell geht auch If GetDataClosedWB(Pfad, Dateiname, Blatt, Bereich, Ziel) Then MsgBox "Daten importiert" End If End Sub

Sub Lese_Daten() Dim ArDataFile, ArDataCell, ArErgebnis() Dim sFormel$, sFileFullPath$ Dim n&, nn& With ThisWorkbook.ActiveSheet 'Tabelle evtl. anpassen n = .Cells(.Rows.Count, 2).End(xlUp).Row If n < 5 Then Exit Sub ArDataFile = .Range("B5", .Cells(n, 2)).Resize(, 3) n = .Cells(3, .Columns.Count).End(xlToLeft).Column If n < 5 Then Exit Sub ArDataCell = .Range("E3", .Cells(3, n).Resize(, 2)) Redim Preserve ArDataCell(1 To 1, 1 To Ubound(ArDataCell, 2) - 1) Redim Preserve ArErgebnis(1 To Ubound(ArDataFile), 1 To Ubound(ArDataCell, 2)) On Error Resume Next For n = 1 To Ubound(ArDataFile) If ArDataFile(n, 1) <> "" Then sFileFullPath = ArDataFile(n, 1) & ArDataFile(n, 2) ChDrive ArDataFile(n, 1) ChDir ArDataFile(n, 1) If Dir$(sFileFullPath, vbNormal) <> "" Then For nn = 1 To Ubound(ArDataCell, 2) If ArDataCell(1, nn) <> "" Then sFormel = "'" & ArDataFile(n, 1) & "[" & ArDataFile(n, 2) & "]" & _ ArDataFile(n, 3) & "'!" & .Range(ArDataCell(1, nn)).Address(ReferenceStyle:=xlR1C1) ArErgebnis(n, nn) = ExecuteExcel4Macro(sFormel) End If Next nn Else For nn = 1 To Ubound(ArDataCell, 2) ArErgebnis(n, nn) = "'Error" Next nn End If End If Next n .Range("E5").Resize(Ubound(ArErgebnis), Ubound(ArErgebnis, 2)) = ArErgebnis End With End Sub

Beliebteste Forumthreads (12 Monate)

	A	B	C	D	E	F	G	H	I
3					C7	F7	I7	C9	F9
4	Nummer	Pfad	Datei	Blatt	Anforderer	Abteilung	akt. Datum	Ziel der Kalkulation	bis
5	14_001	C:\C-TRANSFER\Auslesen geschlossener Dateien\14_001\	14_001.xlsx	Projektdaten

Daten aus geschlossener Arbeitsmappe auslesen

9
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

238 Forumthreads zu ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Daten aus geschlossener Arbeitsmappe auslesen

9 Beiträge zum Forumthread Beiträge zu diesem Forumthread

238 Forumthreads zu ähnlichen Themen

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

9
Beiträge zum Forumthread

Beiträge zu diesem Forumthread