Option Explicit

Sub Копировать4Строки()
    Dim wsGrusha    As Worksheet
    Set wsGrusha = ThisWorkbook.Worksheets("Груша")

    Dim startRow    As Long
    startRow = ActiveCell.Row

    With Application
        .ScreenUpdating = False
        .DisplayAlerts = False
        .Calculation = xlCalculationManual

        With ThisWorkbook.Worksheets("Яблоко")

            If ActiveSheet.Name <> .Name Then
                MsgBox "Макрос запускается только с листа 'Яблоко'.", vbExclamation
                Application.Calculation = xlCalculationAutomatic
                Application.DisplayAlerts = True
                Application.ScreenUpdating = True
                Exit Sub
            End If

            Dim targetRow As Long
            targetRow = Application.InputBox("Введите номер строки, куда вставить скопированные строки:", "Строка вставки", Type:=1)
            If targetRow < 1 Then Exit Sub

            .Rows(startRow & ":" & startRow + 3).Copy
            .Rows(targetRow).Insert Shift:=xlDown

            wsGrusha.Rows(startRow & ":" & startRow + 3).Copy
            wsGrusha.Rows(targetRow).Insert Shift:=xlDown
        End With

        .CutCopyMode = False
        .Calculation = xlCalculationAutomatic
        .DisplayAlerts = True
        .ScreenUpdating = True
    End With

    MsgBox "Готово: строки " & startRow & ":" & (startRow + 3) & " скопированы и вставлены на строку " & targetRow & " на обоих листах.", vbInformation
End Sub