Григорий Боев

Что-то вроде:

Sub ProcessFilesInDirectory()
    Dim folderPath As String
    Dim fileName As String
    Dim wb As Workbook
    
    ' Путь к директории
    folderPath = "C:\temp\"
    
    ' Получаем первый файл с расширением .xlsx в директории
    fileName = Dir(folderPath & "*.xlsx")
    
    ' Перебираем все файлы в директории
    Do While fileName <> ""
        ' Открываем файл
        Set wb = Workbooks.Open(folderPath & fileName)
        
        ' Вызываем функцию macros3
        Call macros3()
        
        ' Сохраняем и закрываем файл
        wb.Close SaveChanges:=True
        
        ' Получаем следующий файл
        fileName = Dir
    Loop
End Sub

Можно и не писать, в большинстве случаев. Оно нужно когда "вызывается" выражение, не начинающееся идентификатора. Вот пример с документации:

Sub TestCall()
    Call (Sub() Console.Write("Hello"))()

    Call New TheClass().ShowText()
End Sub

Class TheClass
    Public Sub ShowText()
        Console.Write(" World")
    End Sub
End Class

Filename = НоваяПапка & ФИО & РасширениеСоздаваемыхФайлов

на
Filename = ФИО & РасширениеСоздаваемыхФайлов

+ можно убрать весь неактуальный код:

НоваяПапка = NewFolderName & Application.PathSeparator
'...
Function NewFolderName() As String
    NewFolderName = Replace(ThisWorkbook.fullName, ThisWorkbook.Name, "Договоры, сформированные " & Get_Now)
    MkDir NewFolderName
End Function

Function ShortName(fullName As String) As String
  Dim arrNames As Variant
  arrNames = Split(fullName)
  ShortName = arrNames(0) & " " & Left(arrNames(1), 1) & "." & Left(arrNames(2), 1) & "."
End Function

Если не морочться с регулярками (а по идее, надо бы), то достаточно поменять строку

Worksheets("Sheet1").Range("A" & i) = Replace(xcell, " ", x)

на что=-то вроде

xcell = Replace(xcell, ".", x)
xcell = Replace(xcell, ",", x)
xcell = Replace(xcell, "(", x)
xcell = Replace(xcell, ")", x)
xcell = Replace(xcell, " ", x)
Worksheets("Sheet1").Range("A" & i) = xcell

Но вообще, как и говорил, лучше подключить регулярки (это минутное дело) и использовать их
Вот, например, статья на русском

Это подстановочные знаки.
? – любой отдельный символ;
* – любое количество любых символов, в том числе ноль символов;
~ – тильда ставится перед ?, * и ~, чтобы они обозначали сами себя
Чтобы тильда в шаблоне обозначала сама себя, записать ее нужно дважды: ~~

С помощью регулярок (надо подключить библиотеку к проекту, чтобы работало):
Tools – References…
☑ Microsoft VBScript Regular Expression
Код:

Public Function getShortName(strText As Variant) As String
    Dim myRegExp As New RegExp
    Dim matches As MatchCollection

    myRegExp.Global = True
    myRegExp.IgnoreCase = True
    myRegExp.Pattern = "(\S+)\s+(\S)\S*\s+(\S)\S*"
    Set matches = myRegExp.Execute(strText)
    
    getShortName = matches(0).SubMatches(0) & " " & matches(0).SubMatches(1) & "." & matches(0).SubMatches(2) & "."
End Function

Можно через Split(), даже покороче получится код, хотя на двойных пробелах споткнётся.

Function getShortName(strText As String) As String
    Dim a
    a = Split(strText, " ")    
    getShortName = a(0) & " " & Left(a(1), 1) & "." & Left(a(2), 1) & "."
End Function

А можно вообще формулой сделать - отталкивайтесь от поиска текста(пробелов)

Sub FillRange()
    Dim i As Integer
    
    For i = 1 To 10
        Cells(i, i).Value = i
    Next i
End Sub

Если надо на конкретном листе, то ещё надо
Worksheets("Лист1").Cells(i, i).Value = i

Если религия позволяет пользоваться гугл таблицами, то там так:
=МАКС(FILTER(B:B;A:A=A1))
Если нужен именно Excel, то там алгоритм такой:
1) Проходите по строкам. Складываете всё в словарь. Первый столбец: ключ, второй: значение. При этом проверяете, если ключ есть, то заменяете значение только если текущее больше уже сохраненного. После одного прохода останется только вывести данные из словаря в массив и положить из в диапазон, или вернуть из юзер-функции

Если массив двумерный, то сначала идёт столбец, а потом строка, т.е. a(2,3) - это 2й столбец 3я строка. Скорее всего дело в этом. Попробуйте такой код для демонстрации:

Public Function a()
    Dim s(1 To 5, 1 To 5)
    For i = 1 To 5
        For j = 1 To 5
            s(i, j) = CStr(i) + " " + CStr(j)
        Next j
    Next i
    a = s
End Function