Sub FindIt()Dim i As Long
Dim FinalRow As Long
With Worksheets(1).Range("a1:a500")
FinalRow = Cells(Rows.Count, 1).End(xlUp).Row
For i = 1 To FinalRow
If Cells(i, 1).Value = Cells.Find(What:="user", After:=ActiveCell, LookIn:=xlValues, _
        LookAt:=xlPart, SearchOrder:=xlByColumns, SearchDirection:=xlNext, _
        MatchCase:=False) Then Cells(i, 2) = Cells(i, 1).Value
        firstAddress = Cells(i, 2).Address
        Do
        Cells(i, 2) = .FindNext()
        Loop While Not Cells(i, 2) Is Nothing And Cells(i, 2).Address <> firstAddress
Next i
End With
End Sub

Sub Fnd()
findText = "user"
For Each WS In Worksheets
    Set c = WS.Cells.Find(What:=findText, After:=ActiveCell, LookIn:=xlValues, LookAt:= _
        xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False)
    If Not c Is Nothing Then
        
        Do
            c.Value = "hh"
            Set c = WS.Cells.FindNext(c)
            If c Is Nothing Then Exit Do
        Loop
        
    End If
Next
End Sub

Sub FindIt()
Dim i As Long
Dim FinalRow As Long
FinalRow = Cells(Rows.Count, 1).End(xlUp).Row
For i = 1 To FinalRow
If Cells(i, 1).Value = Cells.Find(What:="user", After:=ActiveCell, LookIn:=xlValues, _
        LookAt:=xlPart, SearchOrder:=xlByColumns, SearchDirection:=xlNext, _
        MatchCase:=False) Then Cells(i, 2) = Cells(i, 1).Value


Next i
End Sub

Private Sub workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Call SaveWbCopy
End Sub

Option Explicit
'---------------------------------------------------------
Const sDefPath$ = "C:\eee"   ' путь для автосохранения по умолчанию"
Const sHK$ = "^+s"   ' хоткей Ctrl+Shift+S
'-------- глобальные переменные --------------------------
Public sSavePath$   ' текущий путь для автосохранения
Public iPeriod%   ' период автосохранения (минут)
Public bAutoSave As Boolean   ' флаг управления режимом автосохранения включен/выключен

Sub SaveWbCopy()   ' сохранить копию открытой книги
    On Error Resume Next
    Dim Wb As Workbook: Set Wb = ThisWorkbook
    Dim sSuffix$, sExpansion$, sFileName$
    sSuffix = " [" & Format(Now, "yyyy/mm/dd hh-mm'ss''") & "]"   ' суффикс к имени файла копии - дата и время сохренения копии файла
    sExpansion = Right(Wb.Name, Len(Wb.Name) - InStrRev(Wb.Name, ".") + 1)   ' расширение файла (".xls")
    sFileName = Left(Wb.Name, Len(Wb.Name) - Len(sExpansion)) & sSuffix & sExpansion    ' "Книга1 [2010.06.02 10-30'22''].xls"
    sSavePath = "C:\eee"
    Wb.SaveCopyAs sSavePath & sFileName
End Sub

Option Explicit
'---------------------------------------------------------
Const sDefPath$ = "/Desktop/Новая папка"   ' путь для автосохранения по умолчанию"
Const sHK$ = "^+s"   ' хоткей Ctrl+Shift+S
'-------- глобальные переменные --------------------------
Public sSavePath$   ' текущий путь для автосохранения
Public iPeriod%   ' период автосохранения (минут)
Public bAutoSave As Boolean   ' флаг управления режимом автосохранения включен/выключен


Sub SaveWbCopy()   ' сохранить копию открытой книги
    On Error Resume Next
    Dim Wb As Workbook: Set Wb = ThisWorkbook
    Dim sSuffix$, sExpansion$, sFileName$
    sSuffix = " [" & Format(Now, "yyyy/mm/dd hh-mm'ss''") & "]"   ' суффикс к имени файла копии - дата и время сохренения копии файла
    sExpansion = Right(Wb.Name, Len(Wb.Name) - InStrRev(Wb.Name, ".") + 1)   ' расширение файла (".xls")
    sFileName = Left(Wb.Name, Len(Wb.Name) - Len(sExpansion)) & sSuffix & sExpansion    ' "Книга1 [2010.06.02 10-30'22''].xls"
    sSavePath$ = ThisWorkbook.Path
    Wb.SaveCopyAs sSavePath & sFileName
End Sub

Sub Refresh_All()
ThisWorkbook.RefreshAll

    Dim ra As Range, delra As Range, ТекстДляПоиска As String, ТекстДляПоиска2 As String
    Application.ScreenUpdating = False    ' отключаем обновление экрана

    ТекстДляПоиска = "(пусто)"    ' удаляем строки с таким текстом

    ' перебираем все строки в используемом диапазоне листа
    For Each ra In ActiveSheet.UsedRange.Rows
        ' если в строке найден искомый текст
        If Not ra.Find(ТекстДляПоиска, , xlValues, xlPart) Is Nothing Then
            ' добавляем строку в диапазон для удаления
            If delra Is Nothing Then Set delra = ra Else Set delra = Union(delra, ra)
        End If
    Next
    ' если подходящие строки найдены - удаляем их
    If Not delra Is Nothing Then delra.EntireRow.Hidden = True

Dim i As Integer, d As Integer
    Application.ScreenUpdating = False
    d = ActiveSheet.UsedRange.Rows.Count
    For i = 2 To d
    If Cells(i, 1).Value <> "(пусто)" And Cells(i, 1).Value <> "" Then
        Rows(i).Hidden = False
    End If
    Next i
    Application.ScreenUpdating = True
    Application.StatusBar = "Поиск " & i & " из " & d

Call SaveWbCopy
End Sub

Option Explicit
'---------------------------------------------------------
Const sDefPath$ = "/Users/user/Desktop/Новая папка"   ' путь для автосохранения по умолчанию"
Const sHK$ = "^+s"   ' хоткей Ctrl+Shift+S
'-------- глобальные переменные --------------------------
Public sSavePath$   ' текущий путь для автосохранения
Public iPeriod%   ' период автосохранения (минут)
Public bAutoSave As Boolean   ' флаг управления режимом автосохранения включен/выключен


Sub SaveWbCopy()   ' сохранить копию открытой книги
    On Error Resume Next
    Dim Wb As Workbook: Set Wb = ThisWorkbook
    Dim sSuffix$, sExpansion$, sFileName$
    sSuffix = " [" & Format(Now, "yyyy/mm/dd hh-mm'ss''") & "]"   ' суффикс к имени файла копии - дата и время сохренения копии файла
    sExpansion = Right(Wb.Name, Len(Wb.Name) - InStrRev(Wb.Name, ".") + 1)   ' расширение файла (".xls")
    sFileName = Left(Wb.Name, Len(Wb.Name) - Len(sExpansion)) & sSuffix & sExpansion    ' "Книга1 [2010.06.02 10-30'22''].xls"
    Wb.SaveCopyAs sSavePath & sFileName
End Sub