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