"[Date].[MonthNumber, Year].&[" & Range("U3").Value & "]",

"[Date].[MonthNumber, Year]." &"[" & Range("U3").Value & "]",

ActiveSheet.PivotTables("Сводная таблица11").PivotFields( _
        "[Date].[MonthNumber, Year].[MonthNumber, Year]").VisibleItemsList = Array( _
        "[Date].[MonthNumber, Year].&[02.2024]", "[Date].[MonthNumber, Year].&[12.2023]")

    Dim r As Long
    For r = ActiveWorkbook.Worksheets("Бренды без продаж W").Cells(Rows.Count, "A").End(xlUp).Row To 2 Step -1
        If ActiveWorkbook.Worksheets("Бренды без продаж W").Cells(r, "B") & Cells(r, "C") & Cells(r, "D") = "" Then Rows(r).Delete
    Next r
    MsgBox "Done"

'Ищем последнюю ячейку на листе, в которой хранится хоть какое-то значение
    Set rF = ActiveSheet.Range("D1:D1000").Find("*", , xlValues, xlWhole, , xlPrevious)
    If Not rF Is Nothing Then
        lLastRow = rF.Row    'последняя заполненная строка
        lLastCol = rF.Column 'последний заполненный столбец
    End If

Range(rF, rF).Select

Do
    ActiveCell.Offset(-1, 0).Activate
        If ActiveCell = "" Then
            If ActiveCell.Offset(0, -1) = "" Then
                If ActiveCell.Offset(0, -1) = "" Then
                    ActiveCell.EntireRow.Delete
                End If
            End If
        End If
    lLastRow = lLastRow - 1
    
Loop While lLastRow <> 2

Private Sub Label11_Click()
    Me.MultiPage1.Value = 0
    Label12.ForeColor = vbWhite
    Label13.ForeColor = vbWhite
    Label14.ForeColor = vbWhite
    Label15.ForeColor = vbWhite
    Label16.ForeColor = vbWhite
    Label17.ForeColor = vbWhite
    Label11.ForeColor = vbYellow
End Sub
Private Sub Label12_Click()
    Me.MultiPage1.Value = 1
    Label12.ForeColor = vbYellow
    Label13.ForeColor = vbWhite
    Label14.ForeColor = vbWhite
    Label15.ForeColor = vbWhite
    Label16.ForeColor = vbWhite
    Label17.ForeColor = vbWhite
    Label11.ForeColor = vbWhite
End Sub

Application.ScreenUpdating = False
Application.EnableEvents = False
Application.DisplayAlerts = False

'Выгружаем форму
Unload 'Дальше не знаю как продолжить

'Загружаем форму (Главная)
Load FormHome

Application.ScreenUpdating = True
Application.EnableEvents = True
Application.DisplayAlerts = True

Dim FormProga As UserForm
    For Each FormProga In ActiveWorkbook.UserForm
             FormProga.UserForm.Unload
    Next

Dim FormProga As UserForm
    For Each FormProga In ActiveWorkbook.UserForm
             FormProga.Unload.UserForm
    Next

Dim ND As String
ND = "#Н/Д"
    
Dim UdalenieStrok As Long
    UdalenieStrok = Cells(Rows.Count, 1).End(xlUp).row
        i = UdalenieStrok
     
Do
    Cells(i, 2).Select
        If ActiveCell = ND Then
            Cells(i, 3).Select
                If ActiveCell = "#Н/Д" Then
                    Cells(i, 4).Select
                        If ActiveCell = "#Н/Д" Then
                            Cells(i, 5).Select
                                If ActiveCell = "#Н/Д" Then
                                    Rows(i).Delete
                                End If
                        Else
                            GoTo Prohod2
                        End If
                Else
                    GoTo Prohod2
                End If
        Else
            GoTo Prohod2
        End If
Prohod2:
    i = i - 1
Loop While i <> 1

Sub SpliTest()
  Dim r&, re, ms, s$
  Set re = CreateObject("VBScript.RegExp")
  re.Pattern = "[А-Яа-яЁё ]+":  r = 26
  Do While Not IsEmpty(Cells(r, 2))
        If ActiveCell Like "*" & "Установка" & "*" Or ActiveCell Like "*" & "Приточная" & "*" Or ActiveCell Like "*" & "Вытяжная" & "*" _
        Or ActiveCell Like "*" & "id" & "*" Then
            r = r + 1
            GoTo Prodoljit
        End If
    s = Cells(r, 2)
    If re.test(s) Then
      Set ms = re.Execute(s)
      Cells(r, 2) = Trim(ms(0))
      Cells(r, 3) = Right(s, Len(s) - Len(ms(0)))
    End If
Prodoljit:
    r = r + 1
  Loop
End Sub

Sub SpliTest()
  Dim r&, re, ms, s$
  Set re = CreateObject("VBScript.RegExp")
  re.Pattern = "[А-Яа-яЁё ]+":  r = 26
  Do While Not IsEmpty(Cells(r, 2))
        If ActiveCell Like "*" & "Установка" & "*" Or ActiveCell Like "*" & "Приточная" & "*" Or ActiveCell Like "*" & "Вытяжная" & "*" _
        Or ActiveCell Like "*" & "id" & "*" Then
            r = r + 1
            GoTo Prodoljit
        End If
    s = Cells(r, 2)
    If re.test(s) Then
      Set ms = re.Execute(s)
      Cells(r, 2) = Trim(ms(0))
      Cells(r, 3) = Right(s, Len(s) - Len(ms(0)))
    End If
Prodoljit:
    r = r + 1
  Loop
End Sub