Private Sub Worksheet_Change(ByVal Target As Range)

    Dim Cell

    If Not Intersect(Target, Range("A1:A10000")) Is Nothing Then

        Cell = Target.Value
    
        If Cell = InStr(AnforderungVal, vbNewLine) = 1 Then 'Тут видимо что то не правильно
            Rows.RowHeight = Rows.RowHeight + 5
        End If
    
    End If

End Sub

=СЧЁТЕСЛИМН(ЗАЯВКИ!$A$1;"*"&A1&"*";ЗАЯВКИ!$B$1;"*ОТ*";ЗАЯВКИ!$C$1;"ЗАКАЗАНО")

Private Sub Worksheet_Change(ByVal Target As Range)
    
    Dim Cell

    Cell = ActiveCell.Value 'Тут я так понимаю мне нужно указать диапазон A1:A10000
    
    If IsDate(Cell) And Format(Cell, "mm/dd/yyyy") <> Cell Then
        MsgBox "Неверная дата" & Cell
    End If

End Sub

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)

    Dim logRow As Long
    
    logRow = Лист6.Cells(Лист6.Rows.Count, 1).End(xlUp).Row + 1 'Так понимаю что тут нужно что то изменить чтобы была 57 строка
    
    Лист6.Cells(logRow, 1).Value = Application.UserName
    Лист6.Cells(logRow, 2).Value = Format(Now, "dd mmmm yyyy")
    Лист6.Cells(logRow, 3).Value = Format(Now, "hh:mm")
    Лист6.Cells(logRow, 4).Value = Sh.Name
    Лист6.Cells(logRow, 5).Value = Target.Address(0, 0)
    Лист6.Cells(logRow, 6).Value = Target.Value
    
    Лист6.Hyperlinks.Add _
    Anchor:=Лист6.Cells(logRow, 7), _
    Address:="#'" & Sh.Name & "'!" & Target.Address, _
    TextToDisplay:="Перейти в ячейку"

End Sub

    With Range("A2:A10000")
        .Formula = "='" & sPath & "[" & sFile & "]" & sShName & "'!" & "A3"
        .Value = .Value
    End With  

Private Sub Worksheet_Activate()

    Dim sPath As String, sFile As String, sShName As String
    
    sPath = ThisWorkbook.Path & "\"
    sFile = "Файл.xlsx"
    sShName = "Лист"
    
    Application.DisplayAlerts = 0
    
    With Range("A3:A10000")
        .Formula = "='" & sPath & "[" & sFile & "]" & sShName & "'!" & "A3"
        .Value = .Value
    End With
    
    With Range("B3:B10000")
        .Formula = "='" & sPath & "[" & sFile & "]" & sShName & "'!" & "B3"
        .Value = .Value
    End With
    
    Application.DisplayAlerts = 1

End Sub

Range("A1").Formula = "=СЕГОДНЯ()"

=@СЕГОДНЯ()