als Testumgebung:

Sub MkTables()
'
'******************************************************************************
' Name : MkTables / erstellt : 25.11.2014 / 15:48 / Sub
'------------------------------------------------------------------------------
'
' Prozedur zur Erstellung einer neutralen Testumgebung
' IN NEUES EXCEL-WORKBOOK mit NUR 1 leeren TABELLE AUFNEHMEN
'
'******************************************************************************
'
Const TABZAHL As Long = 2
Const TABNAME As String = "Kunde"
Const TABPOSK As String = "B2"
Const SUMPOSK As String = "B2"
Const TABKOPF As String = "Kunde ,Datum,Erlöse,Aufwand,Ergebnis"
Const SUMKOPF As String = "Kunde ,Kategorie,Betrag,Datum"
Dim oWbk As Excel.Workbook
Dim owsh As Excel.Worksheet
Dim c As Excel.Range
Dim aKopf() As String
Dim strName As String
Dim lCnt As Long

Application.DisplayAlerts = False
Set oWbk = ThisWorkbook

With oWbk

   lCnt = 1
   strName = TABNAME
   .Sheets(1).Name = strName & Format(lCnt, "00")
   ThisWorkbook.VBProject.VBComponents(.Sheets(1).CodeName).Name = .Sheets(1).Name
   
   For lCnt = .Sheets.Count To 2 Step -1
      .Sheets(lCnt).Delete
   Next lCnt
   For lCnt = 2 To TABZAHL
      .Sheets.Add After:=.Sheets(.Sheets.Count)
      .Sheets(.Sheets.Count).Name = strName & Format(lCnt, "00")
      ThisWorkbook.VBProject.VBComponents(.Sheets(.Sheets.Count).CodeName).Name = _
         strName & Format(lCnt, "00")
   Next lCnt
   
   aKopf = Split(TABKOPF, ",")
   
   For Each owsh In oWbk.Sheets
      With owsh
         .Cells.Clear
         Set c = .Range(TABPOSK)
         c.Value = owsh.Name
         For lCnt = 1 To UBound(aKopf)
            c.Offset(lCnt).Value = aKopf(lCnt)
         Next lCnt
         For lCnt = 1 To 12
            c.Offset(1, lCnt).Value = DateSerial(2014, lCnt, 1)
            c.Offset(2, lCnt).Value = WorksheetFunction.RandBetween(lCnt * 20, lCnt * 80)
            c.Offset(3, lCnt).Value = c.Offset(2, lCnt).Value - _
               WorksheetFunction.RandBetween(lCnt * 10, lCnt * 70)
            c.Offset(3, lCnt).Value = Abs(c.Offset(3, lCnt).Value)
            c.Offset(4, lCnt).Value = c.Offset(2, lCnt).Value - _
               c.Offset(3, lCnt).Value
         Next lCnt
      End With
   Next owsh
   
   .Sheets.Add After:=.Sheets(.Sheets.Count)
      .Sheets(.Sheets.Count).Name = "SummenBlatt"
      ThisWorkbook.VBProject.VBComponents(.Sheets(.Sheets.Count).CodeName).Name = _
        "SummenBlatt"
   With Sheets("SummenBlatt")
      aKopf = Split(SUMKOPF, ",")
      For lCnt = LBound(aKopf) To UBound(aKopf)
         Range(SUMPOSK).Offset(0, lCnt).Value = aKopf(lCnt)
      Next lCnt
   End With
End With

Set oWbk = Nothing
Application.DisplayAlerts = True
End Sub

bei mir klappt in der Testumgebung:

Option Explicit

Sub TryItWithFormulas()
'
'******************************************************************************
' Name : TryItWithFormulas / erstellt : 25.11.2014 / 15:51 / Sub
'------------------------------------------------------------------------------
'
' abgestimmt auf Testumgebung Sub MkTables()
'
'******************************************************************************
'
Const TABPOSK As String = "B2" 'Position Kundenname
Const TABPOSS As String = "B2" 'Position Summenblatt Überschrift
Const TABSUMM As String = "SummenBlatt"   'Blattname Ergenisliste
Dim oWbk As Excel.Workbook
Dim owsh As Excel.Worksheet
Dim Arr() As Variant
Dim rngc As Range, rngNext As Range

Set oWbk = ThisWorkbook

With oWbk
   For Each owsh In oWbk.Sheets
    If owsh.Name <> TABSUMM Then
      With owsh
         Arr = ShtFormulas(owsh, TABPOSK)
         With Sheets(TABSUMM)
            Set rngc = .Range(TABPOSS).EntireColumn.Cells(1)
            Set rngNext = .Range(TABPOSS).EntireColumn.Find("*", rngc, -4123, 2, , 2).Offset(1)
            rngNext.Resize(UBound(Arr, 1), UBound(Arr, 2)).Formula = Arr
         End With
      End With
    End If
   Next owsh
End With

Set oWbk = Nothing

End Sub

Function ShtFormulas(wsh As Worksheet, rngBegin As String) As Variant
Dim c As Range, ca As Range
Dim arrSrc(), arrTrg(), arrSic()
Dim i As Long, k As Long, l As Long, z As Long
Dim strKat As String, strKde As String

With wsh
   Set c = .Range(rngBegin)
   strKde = c.Text
   Set c = .Range(rngBegin).CurrentRegion      'Block steht frei !!!
   'oder Block für 4 Zeilen, 12 Monate breit
   'Set c = Range(.Range(rngBegin), .Range(rngBegin).Offset(4, 12))
   arrSic = c
   Set c = .Range(rngBegin).CurrentRegion      'Block steht frei !!!
   For Each ca In .Range(c.Address)
      If IsDate(ca.Value) Then ca.Formula = wsh.Name & "!" & ca.Address
      If IsNumeric(ca.Value) Then ca.Formula = wsh.Name & "!" & ca.Address
   Next ca
   Set c = .Range(rngBegin).CurrentRegion      'Block steht frei !!!
   arrSrc = c
   Set c = .Range(rngBegin).CurrentRegion      'Block steht frei !!!
   c.Value = ""
   .Range(rngBegin).Resize(UBound(arrSic, 1), UBound(arrSic, 2)).Value = arrSic
End With

i = (UBound(arrSrc, 2) - 1) * (UBound(arrSrc, 1) - 2)
ReDim arrTrg(1 To i, 1 To 4)

For l = 3 To UBound(arrSrc, 1)
   strKat = arrSrc(l, 1)
   For k = 2 To UBound(arrSrc, 2)
      z = z + 1
      arrTrg(z, 1) = strKde
      arrTrg(z, 2) = strKat
      arrTrg(z, 3) = Chr(61) & arrSrc(l, k)
      arrTrg(z, 4) = Chr(61) & arrSrc(2, k)
      'arrTrg(z, 3) = Chr(34) & Chr(61) & arrSrc(l, k) & Chr(34)
      'arrTrg(z, 4) = Chr(34) & Chr(61) & arrSrc(2, k) & Chr(34)
   Next k
Next l

ShtFormulas = arrTrg
End Function