Dim i As Integer
Dim j As Integer
Dim WB As Workbook
Dim WS As Worksheet
Dim orange As Range


Set WB = ThisWorkbook
j = ActiveCell.Column
i = 3


 If WS.Name Like "*Other*" Then
   WS.Select
  ActiveSheet.Range ("B1:Z500")
  orange.Replace What:=Range("A3"), Replacement:=Range("A4"),
  MatchCase:=True

Else

   With WS

    For i = 3 To 5
    If .Range("A" & i) = "y" And IsEmpty(Cells(i, j)) Then
        .Cells(i, j - 1).Copy .Cells(i, j - 1).Offset(0, 1)

        .Cells(i, j - 1).Offset(0, 1).Select

End If

Next i