Geschlossene Datei - Zelle auslesen!

Im Herber Forum gefragt: Eine Exceldatei gleichen Aufbaus ist in verschiedenen Ordnern abgelegt. Alle aber unter einem "Oberordner". Nun soll nach Eingabe des Ordners in Zelle A2 der Inhalt von z. B. D10 aus der jeweiligen Datei ausgelesen werden. Diese soll dabei geschlossen bleiben. Also:

In die Zelle A2 entweder "Test1", "Test2", "Test3" oder "Test4" schreiben!
Klein- Großschreibung ist egal.
Test1-4 sind Ordner - alle unter "Thisworkbook.Path" - in denen jeweils dieselbe Datei ist.
Aus dieser Datei wird eine bestimmte Zelle ausgelesen und in A3 angezeigt
Bei Eingabe eines nicht vorhandenen Ordners erscheint der Datei-Öffnen-Dialog.


Erklärungen auch im Download.

Geschlossene Datei - Zelle auslesen - WorkSheet_Change...[ZIP, 70 KB]

Option Explicit
Const strSheet As String = "Tabelle1" ' Anpassen!!!
Const strFile As String = "Rapport.xls" ' Anpassen!!!
Const strCell As String = "D10" ' Anpassen!!!
'Const strPath As String = "C:\Temp\" ' Anpassen!!!
Private Sub Worksheet_Change(ByVal Target As Range)
Dim strPath As String
On Error GoTo Fin
strPath = ThisWorkbook.Path & "\"
If Target.Count > 1 Then Exit Sub
Application.EnableEvents = False
If Not Intersect(Target, Range("A2")) Is Nothing Then
If Trim(Target.Value) <> "" Then
With Me
.Range("A3").Formula = "='" & strPath & _
.Range("A2").Value & "\" & "[" & _
strFile & "]" & strSheet & "'!" & strCell
.Range("A3").Value = .Range("A3").Value
End With
Else
Me.Range("A3").ClearContents
End If
End If
Fin:
Application.EnableEvents = True
If Err.Number <> 0 Then MsgBox "Fehler: " & _
Err.Number & " " & Err.Description
End Sub

Kommentare

Beliebte Posts aus diesem Blog

Formeln - auch Array - per VBA eintragen...

Alle Dateien eines Ordners - Optional mit Unterordner

Excel -> Word in Textmarken (Bookmarks)...