Sub HorizontalSpiegeln()
'Application.ScreenUpdating = False
For i = 1 To 40
    With Worksheets("buch 1")
        .Columns(i).Copy
        .Columns(90 - i).PasteSpecial
    End With
    'Application.ScreenUpdating = True
    DoEvents
Next i
'Application.ScreenUpdating = True
End Sub

Set mcells = Intersect(Target, Range("B6:F8"))
If Not mcells Is Nothing Then 
Application.EnableEvents = False
Application.ScreenUpdating = False
    For Each mcell In mcells

Private предел_исо As Double ' Множитель предела исо
Private макс_на_пределе As Integer ' максимальное значение на пределе

Private Sub Worksheet_Change(ByVal Target As Range)
Dim mcell As Range
On Error GoTo ErrorHendler
If Not Intersect(Target, Range("B6:F8")) Is Nothing Then ' проверяем что изменения в нужном диапазоне ячеек
Application.EnableEvents = False
Application.ScreenUpdating = False
    For Each mcell In Intersect(Target, Range("B6:F8")) ' перебираем диапазон ячеек что изменились в нужном диаазоне
        If mcell <> "" Then '  проверка на то что стерли данные в ячейке
            If IsNumeric(mcell) Then ' проверяем что число
                Select Case True
                Case mcell <= 0  ' проверяем что > 0
                    MsgBox "Ошибочный ввод. Значение должно быть больше нуля " & mcell.Address(0, 0), 64 ' если  <=0 выдаем предупреждение
                Case mcell > макс_на_пределе  ' проверяем что не превышает максимально допустимое.
                    MsgBox "Ошибочный ввод. Значение выше предела диапазона измерений" & mcell.Address(0, 0), 64
                Case Else
                    mcell = mcell * предел_исо ' умножаем на множитель для исо
                End Select
            End If
        End If
    Next
ErrorHendler:
Application.ScreenUpdating = True
Application.EnableEvents = True
End If
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
Dim mcell As Range
On Error GoTo ErrorHendler
If Not Intersect(Target, Range("A:B,D:E")) Is Nothing Then
Application.EnableEvents = False
Application.ScreenUpdating = False
    For Each mcell In Intersect(Target, Range("a:b,D:e"))
        If mcell <> "" Then
            If IsNumeric(mcell) Then
                mcell = mcell * 3
            Else
                mcell = mcell & "*3"
            End If
        End If
    Next
ErrorHendler:
Application.ScreenUpdating = True
Application.EnableEvents = True
End If
End Sub

Sub HorizontalSpiegeln()
Application.ScreenUpdating = False
For i = 1 To 20
    With Worksheets("buch 1")
        .Columns(i).Copy
        .Columns(45 - i).PasteSpecial
    End With
Next i
Application.ScreenUpdating = True
End Sub


Sub VertikalSpiegeln()
Application.ScreenUpdating = False
For i = 1 To 20
    With Worksheets("buch 1")
        .Rows(i).Copy
        .Cells(45 - i, 1).PasteSpecial
    End With
Next i
Application.ScreenUpdating = True
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
Dim mcell As Range
On Error GoTo ErrorHendler
Application.EnableEvents = False
    For Each mcell In Target
        If mcell <> "" Then
            If IsNumeric(mcell) Then
                mcell = mcell * 3 / 0
            Else
                mcell = mcell & "*3"
            End If
        End If
    Next
ErrorHendler:
Application.EnableEvents = True
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
Dim mcell As Range
Application.EnableEvents = False
    For Each mcell In Target
        If mcell <> "" Then
            If IsNumeric(mcell) Then
                mcell = mcell * 3
            Else
                mcell = mcell & "*3"
            End If
        End If
    Next
Application.EnableEvents = True
End Su