Sub JoinDoubles()
Dim i As Long
Dim j As Long
Application.DisplayAlerts = False
For j = 1 To Selection.Columns.Count
  For i = Selection.Rows.Count To 2 Step -1
    If Selection.Cells(i - 1, j) = Selection.Cells(i, j) Then
    Range(Selection.Cells(i - 1, j), Selection.Cells(i, j)).Merge
    End If
  Next
Next
Selection.VerticalAlignment = xlVAlignCenter
Application.DisplayAlerts = True
End Sub

Private Sub Workbook_BeforeClose(Cancel As Boolean)
    Application.DisplayAlerts = 0
    Worksheets("AAA").Delete
    Application.DisplayAlerts = 1
End Sub

Private Sub Workbook_Open()
    Sheets("BBB").Select
    Sheets("BBB").Copy After:=Sheets(2)
    Sheets("BBB (2)").Select
    Sheets("BBB (2)").Name = "AAA"
End Sub

Private Sub Workbook_Open()
    If ThisWorkbook.Path <> "C:\Мои документы" Then
        MsgBox "Книга ворованная!", 64, "Фиг вам!"
        ThisWorkbook.Close
    End If
End Sub