ich importiere aus einer geschlossenen Arbeitsmappe bestimmte Zellwerte, das funktioniert tadellos. Allerdings kommt am Ende immer die Fehlermeldung.
"Laufzeitfehler '1004' Anwendungs- oder Objektdefinierter Fehler"
Was kann ich ändern? Ich entnehme Daten ausschließlich im Datenbereich von A1:L30 aus der alten Mappe. Die neue Mappe ist genauso strukturiert wie die alte.
Bin für jeden Hinweis dankbar.
Gruß
Michael
Hier der Code
Option Explicit
Sub TestGetValue()
Dim strFile As String, strPath As String, strWBook As String, strSheet As String
Dim strCell() As String, strRef As String, strRange() As String
Dim lngIndex As Long, lngCell As Long, rng As Range
strFile = Application.GetOpenFilename("Excel Dateien (*.xls; *.xlsm)," & _
"*.xls; *.xlsm", 1, "Datei zum Datenimport auswählen")
If strFile = "Falsch" Then Exit Sub
strPath = Left(strFile, InStrRev(strFile, "\"))
strWBook = Right(strFile, Len(strFile) - Len(strPath))
strRef = "pers. Angaben!C3:C5,C7:C9,C12,C14,C16,C18,C20,C22,D23,C26;pers. Angaben!F3:F5,F7:F9,F12,F14,F16,F18,F20,F22,G23,F26"
'Tabellenname!Zelladresse(n) - Anpassen!
'Tabellen getrennt durch ; - Zellen(bereiche) getrennt durch ,
'Beispiel "Tabelle1!A1:A10,C1:C10;Tabelle2!C5,C7"
strRange = Split(strRef, ";")
For lngIndex = 0 To UBound(strRange)
strSheet = Left(strRange(lngIndex), InStr(1, strRange(lngIndex), "!") - 1)
strCell = Split(Mid(strRange(lngIndex), InStr(1, strRange(lngIndex), "!") + 1), ",")
For lngCell = 0 To UBound(strCell)
For Each rng In Range(strCell(lngCell))
ThisWorkbook.Sheets(strSheet).Range(rng.Address) = _
GetValue(strPath, strWBook, strSheet, rng.Address)
Next
Next
Next
End Sub 'Diese Funktion wird vom obigen Makro benötigt!
Private Function GetValue(path As String, file As String, _
sheet As String, ref As String)
' Retrieves a value from a closed workbook
Dim arg As String
' Make sure the file exists
If Right(path, 1) "\" Then path = path & "\"
If Dir(path & file) = "" Then
GetValue = "File Not Found"
Exit Function
End If
' Create the argument
arg = "'" & path & "[" & file & "]" & sheet & "'!" & _
Range(ref).Range("A1").Address(, , xlR1C1)
' Execute an XLM macro
GetValue = ExecuteExcel4Macro(arg)
End Function