Private Sub Worksheet_Change(ByVal Target As Range)
   If Not Intersect(Target, Range("C1")) Is Nothing Then '(подсвечивается эта строка при ошибке)
       If Target.Value <> "" Then
           If Len(Target.Value) < 30 Then
               Target.Parent.Name = Target.Value
           End If
       End If
   End If
End Sub

Private Sub CommandButton1_Click()
    Range("B11:E110, L11:O110, V11:Y110").ClearContents
End Sub

Public Function CountByColor(DataRange As Range, ColorSample As Range, TextRange As Range) As Double
     Dim iCount As Double
     Application.Volatile True
     For Each cell In DataRange
         If cell.Interior.Color = ColorSample.Interior.Color Then
            If Application.IsText(Cells(cell.Row, TextRange.Column)) = True Then
                iCount = iCount + 1
            End If
        End If
     Next cell
     CountByColor = iCount
 End Function

Option Explicit
Option Compare Text

Sub Поиск()
Dim strText$, arr()
Dim lRow&, I&, J&
Dim hRows As Range
Application.ScreenUpdating = False
Rows.EntireRow.Hidden = False
lRow = Cells(Rows.Count, "A").End(xlUp).Row
With Range("A4:M" & lRow)
    arr = .Value
    .EntireRow.Hidden = True
End With
strText = ActiveSheet.TextBox1.Text
If strText <> "" Then
    For I = LBound(arr) To UBound(arr)
        For J = LBound(arr, 2) To UBound(arr, 2)
            If arr(I, J) Like "*" & strText & "*" Then
                If Not hRows Is Nothing Then
                    Set hRows = Union(hRows, Rows(I + 3))
                Else
                    Set hRows = Rows(I + 3)
                End If
            End If
        Next
    Next
    If Not hRows Is Nothing Then
        hRows.EntireRow.Hidden = False
    Else
        Rows.Hidden = False
    End If
End If
Application.ScreenUpdating = True
End Sub

Sub ПРОПНАЧ()
Dim iCl As Range
For Each iCl In Selection
    iCl = LCase(iCl)
Next
End Sub

Sub ПРОПИСН()
Dim iCl As Range
For Each iCl In Selection
    iCl = UCase(iCl)
Next
End Sub

arr() = Range("A4:M" & lr).Value
For I = LBound(arr, 1) To UBound(arr, 1)    'цикл по 'строка'
    For J = LBound(arr, 2) To UBound(arr, 2) ' цикл по 'столбцам'
        If arr(I, J) = 0 Then
            'какой-то код
        End If
    Next
Next

Sub ПРОПНАЧ()
    Selection.Formula = "=PROPER(A1)"
End Sub

Sub Riddle_1()
arr = Range("A5:B" & Cells(Rows.Count, 2).End(xlUp).Row).Value
ReDim arrNew(1 To UBound(arr), 1 To 2)
For I = 1 To UBound(arr) - 1
    If arr(I, 1) <> "" Then
        N = N + 1
        arrNew(N, 1) = arr(I, 1)
    End If
    If arr(I + 1, 2) <> "" Then
        arrNew(N, 2) = IIf(arrNew(N, 2) <> "", arrNew(N, 2) & ", " & arr(I + 1, 2), arr(I + 1, 2))
    End If
Next
Range("G5").Resize(N, 2) = arrNew
End Sub

    ИтоговаяКнига = Sheets(1).Name & " e-mail.xlsx"
    
    Worksheets("ОАО ХЛЕБ").Copy
    ActiveWorkbook.SaveAs Filename:= _
        "D:\DOWNLOAD\+ Отчеты для отправки по E-MAIL\" & ИтоговаяКнига, FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
    ActiveWindow.Close