Require macro to reduce data by averaging

Hi

See if this will do

Sub aaa()
  Dim OutSh As Worksheet
  Set OutSh = Sheets("Sheet4")
  rowstoaverage = InputBox("Enter number of rows to average", Default:=16)
  OutSh.Range("A1:F1").Value = Range("A1:F1").Value
  For i = 2 To Cells(Rows.Count, 1).End(xlUp).Row Step rowstoaverage
    outrow = OutSh.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
    OutSh.Cells(outrow, 1) = WorksheetFunction.Average(Cells(i, 1).Resize(rowstoaverage, 1))
    OutSh.Cells(outrow, 2) = WorksheetFunction.Average(Cells(i, 2).Resize(rowstoaverage, 1))
    OutSh.Cells(outrow, 3) = WorksheetFunction.Average(Cells(i, 3).Resize(rowstoaverage, 1))
    OutSh.Cells(outrow, 4) = WorksheetFunction.Average(Cells(i, 4).Resize(rowstoaverage, 1))
    OutSh.Cells(outrow, 5) = WorksheetFunction.Average(Cells(i, 5).Resize(rowstoaverage, 1))
    OutSh.Cells(outrow, 6) = WorksheetFunction.Average(Cells(i, 6).Resize(rowstoaverage, 1))
  Next i
  
End Sub

rylo