' добавление к именам выбранных файлов префикса
' префикс зависит от столбца, в котором расположена активная ячейка
Sub renamescanned()
Dim fso As Object, f As Object, FilesToRename
Dim sNamePrefix$
Dim k%

' выбор файлов для переименования
FilesToRename = Application.GetOpenFilename(, , "Выбери себе " & sNamePrefix, , True)

If IsArray(FilesToRename) Then ' выбран хотя бы один файл

    ' префикс имени файла в зависимости от активной ячейки 
    If ActiveCell.Column =  1  Then
    ' активная ячейка в первом столбце
        sNamePrefix = "ПАСПОРТ"
    Else
    ' активная ячейка НЕ в первом столбце
        sNamePrefix = "ЗАЯВЛЕНИЕ"
    End If

    Set fso = CreateObject("Scripting.FileSystemObject")
    
    ' для каждого выбранного файла
    For k =  1  To UBound(FilesToRename)
        Set f = fso.GetFile(FilesToRename(k))
        ' переименование файла (добавление к имени префикса)
        f.Name = sNamePrefix & "_" & f.Name
        Set f = Nothing
    Next k
    
    Set fso = Nothing
    Erase FilesToRename
End If
End Sub