Option Explicit

Public Sub SplitWorksheetByStoreID()
   
  If ActiveSheet Is Nothing Then Exit Sub
  If Not TypeOf ActiveSheet Is Excel.Worksheet Then Exit Sub
   
  If vbCancel = MsgBox("Die Daten, auf dem Aktiven Blatt, werden nun nach der 'store_id' aufgesplittet.", _
                        vbQuestion Or vbOKCancel Or vbDefaultButton2) _
  Then
    Exit Sub
  End If
   
  On Error GoTo ErrHandler
  
  Application.ScreenUpdating = False
   
  Dim wksDst As Excel.Worksheet
  Dim i As Long, j As Long
   
  With ActiveSheet.UsedRange.CurrentRegion
    
    If .Columns.Count < 4 Then
      Call MsgBox("Keine Daten vorhanden.", vbExclamation)
      GoTo SafeExit
    End If
    
    If .Cells(2, 4).Value = WorksheetFunction.Average(.Columns(4)) Then
      Call MsgBox("Falsches Blatt aktiv.", vbExclamation)
      GoTo SafeExit
    End If
    
    Call .Sort(Key1:=.Cells(1, "D"), Order1:=xlAscending, Header:=xlYes)
     
    i = 2
    Do Until i > .Rows.Count
       
      j = i
      Do While .Cells(i, "D") = .Cells(j + 1, "D")
        j = j + 1
      Loop
       
      If WorksheetExists(.Cells(i, "D").Text) Then
        Set wksDst = Worksheets(.Cells(i, "D").Text)
        Call wksDst.UsedRange.Delete
      ElseIf Not wksDst Is Nothing Then
        Set wksDst = ThisWorkbook.Worksheets.Add(After:=wksDst)
        wksDst.Name = .Cells(i, "D").Text
      Else
        Set wksDst = ThisWorkbook.Worksheets.Add(After:=.Worksheet)
        wksDst.Name = .Cells(i, "D").Text
      End If
      
      Call Union(.Rows(1), .Worksheet.Range(.Rows(i), .Rows(j))).Copy
      With wksDst.Range("A1")
        Call .PasteSpecial(xlPasteColumnWidths)
        Call .PasteSpecial(xlPasteValuesAndNumberFormats)
      End With
      
      Call GAForm(wksDst)
      
      i = j + 1
    Loop
     
    Call .Worksheet.Activate
     
  End With
   
  Call MsgBox("Vorgang erfolgreich abschlossen.", _
              vbInformation, _
              "Erfolg")
   
SafeExit:
  Application.CutCopyMode = False
  Application.ScreenUpdating = True
Exit Sub
 
ErrHandler:
  Call MsgBox(Err.Description, _
              vbCritical, _
              "Fehler " & Err.Number)
  GoTo SafeExit
End Sub

Private Sub GAForm(Worksheet As Excel.Worksheet)
  
  Dim rng As Excel.Range
  Set rng = Worksheet.UsedRange.CurrentRegion
  
  If rng.Rows.Count = 1 _
    Then Exit Sub
  
  If Not ActiveSheet Is Worksheet _
    Then Worksheet.Activate
  
  'Datenbereich inkl. neue Summe-Zeile
  With rng.Resize(rng.Rows.Count + 1)
    
    'Kopfzeile
    With rng.Rows(1)
      Call .Clear
      .Font.Bold = True
      .Resize(ColumnSize:=3).Value = Array("Datum", "Code", "Wert")
    End With
    
    'neue Summe-Zeile
    With .Rows(.Rows.Count)
      .Font.Bold = True
      .Cells(1).Value = "Summe"
      .Cells(3).NumberFormat = "#,##0.00 $"
      .Cells(3).Formula = "=SUM(R[-1]C:R[-" & rng.Rows.Count - 1 & "]C)"
    End With
    
    'Datum- und Wert-Spalte formatieren
    .Columns(1).NumberFormat = "dd.mm.yyyy hh:mm"
    .Columns(3).NumberFormat = "#,##0.00 $"
    
    Call .Columns(2).AutoFit
    
    'Rahmen setzen
    .Borders.LineStyle = XlLineStyle.xlContinuous
    .Borders.Weight = XlBorderWeight.xlThin
    
  End With
  
  ActiveWindow.DisplayGridlines = False
  
  Call rng.Resize(RowSize:=4).Insert(xlShiftDown)
  Call rng.Cells(1, 1).Select
  
End Sub

Private Function WorksheetExists(Name As String, Optional ByVal Workbook As Excel.Workbook) As Boolean
  If Workbook Is Nothing Then Set Workbook = ActiveWorkbook
  On Error Resume Next
  WorksheetExists = Not (Workbook.Worksheets(Name) Is Nothing)
End Function