Met een kleine procedure is het zo gepiept...
Sub MaakTotaalSheet()
Dim OutputTable() As Variant
For Each sh In ThisWorkbook.Sheets
If (sh.Name <> "Tabel v totalen" And sh.Name <> "Totalen") Then
TempTable = sh.Cells(1).CurrentRegion
For i = 2 To UBound(TempTable, 1)
Art = IIf(Not IsEmpty(TempTable(i, 1)), TempTable(i, 1), Art)
Oms = IIf(Not IsEmpty(TempTable(i, 1)), TempTable(i, 2), Oms)
If IsEmpty(TempTable(i, 1)) Then
x = x + 1
ReDim Preserve OutputTable(1 To 7, 1 To x)
OutputTable(1, x) = sh.Name
OutputTable(2, x) = Art
OutputTable(3, x) = Oms
OutputTable(4, x) = TempTable(i, 2) ' lotnr
OutputTable(5, x) = TempTable(i, 3) ' aantal
OutputTable(6, x) = TempTable(i, 4) ' werkelijk
OutputTable(7, x) = TempTable(i, 4) - TempTable(i, 3) ' verschil
End If
Next i
End If
Next sh
Sheets("Totalen").Cells(2, 1).Resize(UBound(OutputTable, 2), UBound(OutputTable, 1)) = Application.Transpose(OutputTable)
End Sub
Zie ook de bijlage.
UITERAARD WÉL UITTESTEN OP EEN KOPIE VAN JE WORKBOOK EN NIET RECHTSTREEKS IN HET "ECHTE"