Sub u_128()
    Application.ScreenUpdating = False
    a = Cells(Rows.Count, "a").End(xlUp).Row
    For Each b In Sheets(1).Range("l2:l" & a)
        c = b.Row
        d = Application.Match(b, Sheets(1).Range("l1:l" & c), 0)
        If c = d Then
            Sheets.Add After:=Sheets(Sheets.Count)
            Sheets(Sheets.Count).Name = "(" & b & ")"
            Sheets(1).Columns("A:AE").Copy
            Sheets("(" & b & ")").Columns("A:AE").PasteSpecial Paste:=xlPasteFormats
            Sheets("(" & b & ")").Columns("A:AE").Clear
            Sheets(1).Range("a1:ae1").Copy Sheets("(" & b & ")").Range("a1:ae1")
        End If
        e = Sheets("(" & b & ")").Cells(Rows.Count, "a").End(xlUp).Row + 1
        Sheets(1).Range("a" & c & ":ae" & c).Copy Sheets("(" & b & ")").Range("a" & e)
    Next
    Application.ScreenUpdating = True
End Sub

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    Application.ScreenUpdating = False
    u = Target.Row      'строка заголовка
    v = Target.Column   'столбец заголовка
    s = u + 1                    'верхняя строка таблицы
    w = Cells(Rows.Count, v).End(xlUp).Row              'нижняя строка таблицы
    x = Cells(u, v).End(xlToLeft).Column                'левый столбец таблицы
    h = Cells(u, v).End(xlToLeft).Value
    If h = "" Then x = Cells(u, 1).End(xlToRight).Column
    y = Cells(u, Columns.Count).End(xlToLeft).Column    'правый столбец таблицы
    'проходимся по столбцу заголовка
    For Each b In Sheets(1).Range(Cells(s, v), Cells(w, v))
        On Error Resume Next
        c = b.Row 'очередная строка
        d = Application.Match(b, Sheets(1).Range(Cells(1, v), Cells(c, v)), 0) 'ПОИСКПОЗ()
        If c = d Then 'если это 1-е вхождение, тогда
            Sheets.Add After:=Sheets(Sheets.Count)      'создаем лист
            Sheets(Sheets.Count).Name = "(" & b & ")"   'назовем его: (текст в ячейке)
            Sheets(1).Range(Cells(u, x), Cells(u, y)).Copy 'копипаст заголовка
            With Sheets("(" & b & ")").Range("a1")
                .PasteSpecial Paste:=xlPasteColumnWidths
                .PasteSpecial Paste:=xlPasteFormats
                .PasteSpecial Paste:=xlPasteValues
            End With
        End If
        e = Sheets("(" & b & ")").Cells(Rows.Count, "a").End(xlUp).Row + 1 'строка вставки
        Sheets(1).Range(Cells(c, x), Cells(c, y)).Copy Sheets("(" & b & ")").Range("a" & e) 'втавляем данные
    Next
    Cancel = True
    Application.ScreenUpdating = True
End Sub

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    Application.ScreenUpdating = False
    u = Target.Row      'строка заголовка
    v = Target.Column   'столбец заголовка
    s = u + 1                    'верхняя строка таблицы
    w = Cells(Rows.Count, v).End(xlUp).Row              'нижняя строка таблицы
    x = Cells(u, v).End(xlToLeft).Column                'левый столбец таблицы
    h = Cells(u, v).End(xlToLeft).Value
    If h = "" Then x = Cells(u, 1).End(xlToRight).Column
    y = Cells(u, Columns.Count).End(xlToLeft).Column    'правый столбец таблицы
    'проходимся по столбцу заголовка
    For Each b In Sheets(1).Range(Cells(s, v), Cells(w, v))
        On Error Resume Next
        c = b.Row 'очередная строка
        d = Application.Match(b, Sheets(1).Range(Cells(1, v), Cells(c, v)), 0) 'ПОИСКПОЗ()
        If c = d Then 'если это 1-е вхождение, тогда
            Sheets.Add After:=Sheets(Sheets.Count)      'создаем лист
            Sheets(Sheets.Count).Name = "(" & d & ")"   'назовем его: (ПОИСКПОЗ())
            Sheets(1).Range(Cells(u, x), Cells(u, y)).Copy 'копипаст заголовка
            With Sheets("(" & d & ")").Range("a1")
                .PasteSpecial Paste:=xlPasteColumnWidths
                .PasteSpecial Paste:=xlPasteFormats
                .PasteSpecial Paste:=xlPasteValues
            End With
        End If
        e = Sheets("(" & d & ")").Cells(Rows.Count, "a").End(xlUp).Row + 1 'строка вставки
        Sheets(1).Range(Cells(c, x), Cells(c, y)).Copy Sheets("(" & d & ")").Range("a" & e) 'втавляем данные
    Next
    Cancel = True
    Application.ScreenUpdating = True
End Sub