Sub Mittelwert()
Dim wksArbeitsblatt As Worksheet
Dim wksZielblatt As Worksheet
Dim rngBereich As Range
Dim dblMittelwert As Double
Dim dblZelleRowZielblatt As Double
Dim lngZelleRowArbeitsblatt As Long
Set wksArbeitsblatt = tblBasisdaten
Set wksZielblatt = tblZieldaten
Set dblZelleRowZielblatt = ActiveWorkbook.wksZielblatt.Cells.Row
Set lngZelleRowArbeitsblatt = ActiveWorkbook.wksArbeitsblatt.Cells.Rows
Set rngBereich = wksArbeitsblatt.Range(wksArbeitsblatt.Cells(lngZelleRowArbeitsblatt, 1), _
wksArbeitsblatt.Cells(lngZelleRowArbeitsblatt + 5, 1))
With dblZelleRowZielblatt = 1
For lngZelleRowArbeitsblatt = 2 To 50000 Step 6
dblMittelwert = Application.WorksheetFunction.AverageIf(rngBereich, ">0")
wksZielblatt.Cells(dblZelleRowZielblatt, 1) = dblMittelwert
dblZelleRowZielblatt = dblZelleRowZielblatt + 1
Next lngZelleRowArbeitsblatt
End With
End Sub