Option Explicit
Sub test()
Dim ws As Worksheet
Set ws = ThisWorkbook.Sheets("Sheet2")
Dim letzteA As Long, letzteB As Long
letzteA = ws.Cells(Rows.Count, 1).End(xlUp).Row
Dim Adr As String
Dim i As Long
Dim Av As Double
Dim Anzahl As Long
ws.Range("B2:C" & letzteA).ClearContents
Anzahl = 6
ws.Cells(1, 2) = "Durchschnittt aus " & Anzahl
For i = 2 To letzteA - Anzahl - 1
letzteB = ws.Cells(Rows.Count, 2).End(xlUp).Row
ws.Cells(letzteB + 1, 2) = Application.WorksheetFunction.Average(ws.Range("A" & i & ":A" & i + Anzahl - 1))
ws.Cells(letzteB + 1, 2).NumberFormat = ("0.000")
Adr = ws.Range("A" & i & ":A" & i + Anzahl - 1).Address
ws.Cells(letzteB + 1, 3) = Adr
Next
End Sub