Sub integral2()
Dim i As Integer
Dim j As Integer
Dim sum As Double
Dim wbZiel As Workbook
Dim wbQuelle As Workbook
Set wbQuelle = ThisWorkbook
Set wbZiel = Workbooks.Open("Z:\Luecke\AlDi\ziel.xlsx")
wbQuelle.Activate
Do While ActiveSheet.Name <> Sheets(Sheets.Count).Name
i = 1
j = 2
Do While Cells(i, j) <> ""
sum = 0
i = 1
Do While Cells(i + 1, j) <> ""
sum = sum + ((Cells(i, j) + Cells(i + 1, j)) / 2) * (Cells(i + 1, 1) - Cells(i, 1))
i = i + 1
Loop
wbZiel.Sheets(1).Cells(1, j) = sum
j = j + 1
Loop
ActiveSheet.Next.Activate
Loop
End Sub