Private Sub TextBox1_Change()
TextBox1.Text = Range("Лист1!A3").Value
End Sub

Private Sub CommandButton1_Click()
Sheets("Лист1").[A3] = Me.TextBox1
End Sub

Sub www()
    Dim s
    s = Application.GetOpenFilename("Files (*.*), *.*")
    If s <> False Then
        ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:=s, _
                                   TextToDisplay:=s
    End If
End Sub

Sub КопиВставка()
Workbooks.Open Filename:="C:\Users\Valera\Desktop\Новая папка (2)\Книга2.xlsm"
Workbooks("Книга2.xlsm").Worksheets("Инф. Заказчик").Range("A1:C16").Copy
Workbooks("Книга1.xlsm").Activate
ActiveWorkbook.Worksheets("Инф. Заказчик").Select
Range("A1").Select
ActiveSheet.Paste
Workbooks("Книга2.xlsm").Worksheets("Расчет выброса").Range("A1:C25").Copy
Workbooks("Книга1.xlsm").Activate
ActiveWorkbook.Worksheets("Расчет выброса").Select
Range("A1").Select
ActiveSheet.Paste
Workbooks("Книга2.xlsm").Close
End Sub

Function GetFileName(Optional ByVal Title As String = "Выберите файл для обработки", _
                     Optional ByVal InitialPath, _
                     Optional ByVal MyFilter As String = "Книги Excel (*.xls*),") As String
    ' функция выводит диалоговое окно выбора папки с заголовком Title,
    ' начиная обзор диска с папки InitialPath
    ' возвращает полный путь к выбранной папке, или пустую строку в случае отказа от выбора
    If Not IsMissing(InitialPath) Then
        On Error Resume Next: ChDrive Left(InitialPath, 1)
        ChDir InitialPath    ' выбираем стартовую папку
    End If
    res = Application.GetOpenFilename(MyFilter, , Title, "Открыть")  ' вывод диалогового окна
    GetFileName = IIf(VarType(res) = vbBoolean, "", res)    ' пустая строка при отказе от выбора
End Function
 
Sub ПримерИспользования_GetFileName()
    ИмяФайла = GetFileName("Заголовок окна", ThisWorkbook.Path)   ' запрашиваем имя файла
    ' ===================== другие варианты вызова функции =====================
    ' текстовые файлы, стартовая папка не указана
    '       ИмяФайла = GetFileName("Выберите текстовый файл", , "Текстовые файлы (*.txt),")
    ' файлы любого типа из папки "C:\Windows"
    '       ИмяФайла = GetFileName(, "C:\Windows", "")
    ' ==========================================================================

    If ИмяФайла = "" Then Exit Sub    ' выход, если пользователь отказался от выбора файла
    MsgBox "Выбран файл: " & ИмяФайла, vbInformation
End Sub

Sub Get_All_File_from_Folder()
    Dim sFolder As String, sFiles As String
    With Application.FileDialog(msoFileDialogFolderPicker)
        If .Show = False Then Exit Sub
        sFolder = .SelectedItems(1)
    End With
    sFolder = sFolder & IIf(Right(sFolder, 1) = Application.PathSeparator, "", Application.PathSeparator)
    Application.ScreenUpdating = False
    sFiles = Dir(sFolder & "*.xls*")
    Do While sFiles <> ""
        'открываем книгу
        Workbooks.Open sFolder & sFiles
        'действия с файлом (ниже указываем свой макрос
    Application.DisplayAlerts = False 'эта функция убирает запрос на удаление листа
    Sheets(Array("Лист2", "Лист3")).Select
    ActiveWindow.SelectedSheets.Delete
    Sheets(Array("Лист6", "Лист7")).Select
    ActiveWindow.SelectedSheets.Visible = False
        Application.DisplayAlerts = True 'эта функция убирает запрос на удаление листа
        'все что ниже не удаляем
        ActiveWorkbook.Close True
        sFiles = Dir
    Loop
    Application.ScreenUpdating = True
End Sub
 

Sub СкрытиеСтрокПоУсловию()
    Dim ra As Range, delra As Range, ТекстДляПоиска 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
End Sub
 

           If delra Is Nothing Then Set delra = ra Else Set delra = Union(delra, ra)
 

Private Sub CommandButton1_Click()
    Sheets(Array("Лист1", "Лист2", "Лист3")).Select
    Sheets("Лист1").Activate
    On Error Resume Next
    ' название подпапки, в которую по-умолчанию будет предложено сохранить файл
   Const REPORTS_FOLDER = "Отчет\"
    ' создаём папку для файла, если её ещё нет
   MkDir ThisWorkbook.Path & "\" & REPORTS_FOLDER
    ' выбираем стартовую папку
   ChDrive Left(ThisWorkbook.Path, 1): ChDir ThisWorkbook.Path & "\" & REPORTS_FOLDER

    ' если пользователь отказался от выбора имени файла - отменяем сохранение листа в файл
   If VarType(Filename) = vbBoolean Then Exit Sub

' Сохранить лист в отдельную книгу, сохранить только значения и оформление
    Dim sh As Worksheet, wbNew As Workbook, cFileName
    Set sh = ActiveSheet
    cFileName = ThisWorkbook.Path & "\" & REPORTS_FOLDER & "Отчёт.xls"
    If cFileName = False Then Exit Sub
    Application.ScreenUpdating = False
    ' Копируем лист (при этом создается новый файл с этим листом)
    Dim CurW As Window
    Dim TempW As Window
    Set CurW = ActiveWindow
    Set TempW = ActiveWorkbook.NewWindow
    CurW.SelectedSheets.Copy
    TempW.Close
    Set wbNew = ActiveWorkbook
    ' Заменяем формулы значениями
    For Each iSh In wbNew.Sheets
      iSh.UsedRange.Cells.Value = iSh.UsedRange.Cells.Value
    Next
' Сохраняем файл
    Application.DisplayAlerts = False
    wbNew.SaveAs Filename:=(cFileName), FileFormat:=xlNormal
    ' Закрываем файл и возвращаемся в начало
    wbNew.Close
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
    sh.Activate
    Sheets("Лист1").Select
End Sub

Sub Copy_Data()
    Sheets("Лист3").Range("A1:B2").Copy Range("A1")
End Sub