Sub Rec()
Dim i As Long
Dim j As Long
Dim k As Long
Dim myRange As Range
Set myRange = Range("AJ41:AL500")
Application.DisplayAlerts = False

For k = 1 To myRange.Areas.Count
  For i = 1 To myRange.Areas(k).Rows.Count
  For j = 1 To myRange.Areas(k).Columns.Count
    If myRange.Areas(k).Cells(j, i).Value = "" Then
    myRange.Areas(k).Rows(i).Merge
    myRange.Areas(k).Cells(i, 1).HorizontalAlignment = xlHAlignCenter
    End If
    Next
    Next
Next
Application.DisplayAlerts = True
End Sub

Sub Макрос1()

Dim FilesToOpen
Dim x As Integer
    Application.ScreenUpdating = False
FilesToOpen = Application.GetOpenFilename _
(FileFilter:="Microsoft Excel Files (*.xlsx), *.xlsx", _
MultiSelect:=True, Title:="Выберите файлы")
If TypeName(FilesToOpen) = "Boolean" Then
    MsgBox "Не выбрано ни одного файла!"
    GoTo ExitHandler
End If
x = 1
    Application.Visible = False
While x <= UBound(FilesToOpen)
    Workbooks.Open Filename:=FilesToOpen(x)

    Sheets(1).Range("BP17").Value = "10.06.2022"  'на листе 1 в ячейку BP17 написать "Новая дата окончания"
    Sheets(1).Range("AL1:AL1500").Replace What:="А. А. Корешков", Replacement:="А. А. Котов"
    Sheets(1).Range("AJ41:AL41").Merge 'на листе 1 объединить ячейки AJ41:AL41
    Sheets(1).Range("AM41:AR41").Merge 'на листе 1 объединить ячейки AM41:AR41

    ActiveWorkbook.Close savechanges:=True
    x = x + 1
Wend

ExitHandler:
    Application.ScreenUpdating = True
    Application.Visible = True
    Exit Sub
ErrHandler:
    MsgBox Err.Description
    Resume ExitHandler
End Sub