Range-Variable nicht eintragen
01.05.2021 22:31:41
Oliver
Option Explicit
Public Sub Import()
Dim QPfad As String, QDatei As String, qsh As String, zsh As Worksheet
Dim astrFiles() As String
Dim qrng1 As Range, qrng2 As Range, Zelle As Range
Dim lastR As Long, ialngIndex As Long
QPfad = ThisWorkbook.Path & Application.PathSeparator & "Projekte" & Application.PathSeparator
qsh = "Ressourcenplan"
Set zsh = ThisWorkbook.Sheets("P-Digest")
Set qrng2 = Range("B7:D11")
Set qrng1 = Range("B1")
ActiveSheet.UsedRange.ClearContents
QDatei = Dir$(QPfad & Application.PathSeparator & "*.xlsm")
Do Until QDatei = vbNullString
ReDim Preserve astrFiles(ialngIndex)
astrFiles(ialngIndex) = QDatei
ialngIndex = ialngIndex + 1
QDatei = Dir$
Loop
For ialngIndex = LBound(astrFiles) To UBound(astrFiles)
lastR = ActiveSheet.Range("B" & Application.Rows.Count).End(xlUp).Row
For Each Zelle In qrng1
Zelle = Zelle.Address(False, False)
ActiveSheet.Cells(lastR + 2, 1).Value = _
GetValue(QPfad, astrFiles(ialngIndex), qsh, Zelle)
Next Zelle
For Each Zelle In qrng2
Zelle = Zelle.Address(False, False)
ActiveSheet.Cells(lastR + Zelle.Row - 5, Zelle.Column).Value = _
GetValue(QPfad, astrFiles(ialngIndex), qsh, Zelle)
Next Zelle
Next
End Sub
Private Function GetValue(pfad, datei, blatt, Zelle) As String
Dim arg As String
arg = "'" & pfad & "[" & datei & "]" & blatt & "'!" & Range(Zelle).Range("A1").Address(, , xlR1C1)
GetValue = ExecuteExcel4Macro(arg)
End Function
Oliver