=ЕСЛИ(B3<32;1;ЧАСТНОЕ(B3;31)+1)

=ОСТАТ(A1-1;5)+1

=ВПР(А2;$D$1:$E$5;2;0)

kSim = VBA.Len(Me.Range("AA1").Value)

Private Sub TBox1_Change()
    ' Объявление переменных
    Dim Rg1 As Range          ' Переменная для хранения диапазона ячеек
    Dim kSim As Long, kSt As Long     ' Переменные для хранения целочисленных значений
    Static kSMax As Long     ' Статическая переменная для отслеживания максимальной длины
    
    ' Получение значения из ячейки Y1 и присвоение его переменной kSt
    kSt = Me.Range("Y1").Value
    
    ' Задание диапазона Rg1 для включения ячеек от A2 до указанной ширины в kSt
    Set Rg1 = Me.Range("A2").Resize(, kSt)

    ' Получение длины текста в TBox1 и присвоение ее переменной kSim
    kSim = Len(Me.TBox1.Text)
    
    ' Задание значения ячейки Z1 последним символом текста в TBox1
    Me.Range("Z1").Value = Right(Me.TBox1.Text, 1)
    
    ' Проверка, если длина текста больше или равна предыдущей максимальной длине (kSMax)
    If kSim >= kSMax Then
        ' Задание значения ячейки в Rg1, соответствующей текущей длине, последним символом текста в TBox1
        Rg1.Cells(kSim) = Right(Me.TBox1.Text, 1)
    Else
        ' Очистка содержимого ячейки в Rg1, соответствующей предыдущей максимальной длине
        Rg1.Cells(kSMax).ClearContents
    End If
    
    ' Присвоение текущей длины переменной kSMax
    kSMax = kSim
    
    ' Задание значения ячейки X1 количеству символов, введенных в TBox1
    Me.Range("X1").Value = kSim
End Sub

Sub сохранить_лист()
    Dim awb As Workbook, sh As Worksheet, sFilename$
    Application.DisplayAlerts = True
    Application.CopyObjectsWithCells = False
    Application.ScreenUpdating = False
    For Each sh In ThisWorkbook.Worksheets
        If awb Is Nothing Then
            sh.Copy
            Set awb = ActiveWorkbook
        Else
            sh.Copy After:=awb.Sheets(awb.Sheets.Count)
        End If
    Next
    sFilename = Replace(ThisWorkbook.FullName, "Отчет", "Отчет № от" & Format(Date, "dd mmmm yyyy"))
    Mid(sFilename, Len(sFilename), 1) = "x"
    awb.SaveAs sFilename, xlOpenXMLWorkbook
    awb.Close False
    Application.DisplayAlerts = True
    Application.CopyObjectsWithCells = True
    Application.ScreenUpdating = True
End Sub

sFilename = Replace(ThisWorkbook.FullName, "Отчет", "Отчет №", Range("B4"), "от" & Format(Date, "dd mmmm yyyy"