Sub Grand()
  Set aSheet = ActiveSheet
  For i =  2  To aSheet.UsedRange.Rows.Count
    If HasSheet(aSheet.Cells(i,  6 ).Value) = False Then
      Sheets.Add().Name = aSheet.Cells(i,  6 ).Value
      aSheet.Rows( 1 ).Copy
      Sheets(aSheet.Cells(i,  6 ).Value).Paste
    End If
    n = Sheets(aSheet.Cells(i,  6 ).Value).UsedRange.Rows.Count
    For j =  1  To aSheet.UsedRange.Columns.Count
      Sheets(aSheet.Cells(i,  6 ).Value).Cells(n +  1 , j).Value = aSheet.Cells(i, j).Value
    Next j
  Next i
End Sub

Function HasSheet(SheetName As String) As Boolean
  On Error GoTo Err
  s = Sheets(SheetName).Name
  HasSheet = True
  Exit Function
Err:
  HasSheet = False
End Function