Als Antwort auf diesen Beitrag
Hallo BodoV,
du hast O2016 angegeben. Bei diesem sperrigen Konstrukt ist ohne dies über den Haufen zu werfen VBA die brauchbarste Lösung. Es werden alle Tabellenblätter außer Blatt „Gesamt“ die benötigten Werte aufsummiert.
Option Explicit
Sub Auswertung()
Call Ergebnisse(rngAbfrage:=Tabelle4.Range("C4:C23"), Zielzelle:=Tabelle4.Range("D4"))
End Sub
Sub Ergebnisse(rngAbfrage As Range, Zielzelle As Range)
Dim wks As Worksheet, arrSum(), rngWerte As Range, arrWks(), i&, j&, k&, iST, lZ&, iFund
ReDim arrSum(1 To rngAbfrage.Rows.Count, 1 To 9)
For Each wks In ThisWorkbook.Sheets
If IsNumeric(wks.Name) Then
iST = Application.Match("Nation", wks.Columns(2), 0)
If Not IsError(iST) Then Set rngWerte = wks.Range("B" & iST & ":J" & wks.Rows.Count - iST + 1)
For i = 1 To rngAbfrage.Count
iFund = Application.Match(rngAbfrage.Cells(i, 1), rngWerte.Columns(1), 0)
If Not IsError(iFund) And Not IsError(iST) Then
For j = LBound(arrSum, 2) To UBound(arrSum, 2)
If j <> 7 Then
k = k + 1
arrSum(i, j) = arrSum(i, j) + rngWerte.Cells(iFund, k + 1)
Else
arrSum(i, j) = arrSum(i, 5) - arrSum(i, 6)
End If
Next j
k = 0
End If
Next i
End If
Next
Zielzelle.Resize(UBound(arrSum), 9) = arrSum
End Sub
https://www.herber.de/bbs/user/180868.xlsm
Gruß Uwe