Daten aus geschlossener Arbeitsmappe auslesen
19.07.2015 09:11:59
Kenny
ich habe ein Makro geschrieben / zusammenkopiert was bis auf eine Kleinigkeit super funktioniert. Hoffe ihr könnt mir helfen.
Das Makro liest Daten aus geschlossenen Arbeitsmappen aus und bezieht die Arbeitsmappen-Bezeichnung aus verschiedenen Zellen.
Jetzt sollen die ausgelesenen Werte um 3 Spalten nach rechts eingelesen werden.
Dies funktioniert aber es werden in die erste Spalte die Adresszellen angegeben.
In Spalte A darf aber nichts passieren.
Wie kann ich dies vermeiden?
Am Beispiel wird es deutlicher:
https://www.herber.de/bbs/user/98918.zip
Spalte A: Spalte D:
A1 1 (Wert aus auszulesender Tabelle)
A2 2 (Wert aus auszulesender Tabelle)
A3 3 (Wert aus auszulesender Tabelle)
A4 4 (Wert aus auszulesender Tabelle)
Folgender Code hierzu:
_______________________________________________________
Sub Bereich_auslesen()
'** Dimensionierung der Variablen
Dim pfad As String
Dim datei As String
Dim blatt As String
Dim bereich As Range
Dim zelle As Object
Dim sh As Worksheet
For Each sh In ActiveWorkbook.Worksheets
sh.Activate
If Range("B4") > 0 Then
'** Angaben zur auszulesenden Zelle
pfad = ActiveWorkbook.Sheets("01_Annahmen").Range("A2").Value
datei = ActiveWorkbook.Sheets("01_Annahmen").Range("A3").Value & ".xlsx"
blatt = ActiveSheet.Range("B4").Value
Set bereich = Range("A7:A12")
'** Bereich auslesen
For Each zelle In bereich
'** Zellen umwandeln
zelle = zelle.Address(False, False)
'** Eintragen in Bereich
ActiveSheet.Cells(zelle.Row, zelle.Column + 3).Value = GetValue(pfad, datei, blatt, zelle)
Next zelle
End If
Next
End Sub
Private Function GetValue(pfad, datei, blatt, zelle)
'** Daten aus geschlossener Arbeitsmappe auslesen
'*** Dimensionierung der Variablen
Dim arg As String
'Sicherstellen, dass das datei vorhanden ist
If Right(pfad, 1) "\" Then pfad = pfad & "\"
If Dir(pfad & datei) = "" Then
GetValue = ""
Exit Function
End If
'** Das Argument erstellen
arg = "'" & pfad & "[" & datei & "]" & blatt & "'!" & Range(zelle).Range("A1").Address(, , _
xlR1C1)
'** Auslesen über Excel4Macro
GetValue = ExecuteExcel4Macro(arg)
End Function
________________________________
Vielen Dank im voraus.