Set rr = Union(rr, Cells(li, 1))

Sub Delete()
LastRow = ActiveSheet.UsedRange.Row + ActiveSheet.UsedRange.Rows.Count
For Row = LastRow To 2 Step -1
On Error Resume Next
If Not Cells(Row, 10).Value Like "*235*" Then ActiveSheet.Rows(Row).Delete
Next Row
End Sub

With Sheets("ААА")
.Range("AE9:AE" & .Cells(Rows.Count, "A").End(xlUp).Row).FormulaLocal = "=СУММ(А1+В1)"
End With

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean) 
    Dim MyPass As String 
    Dim Password As String 
    MyPass = "qwerty"    'Строка с паролем для сохранения 
    Password = InputBox("Пароль?", "Сохранение") 
    If MyPass <> Password Then ThisWorkbook.Close savechanges:=False 
End Sub

Sub Макрос1()
Dim n As Range 
For Each n In Range("C:C")  
  If n = Empty Then Exit For
  If n = 0 Then Exit Sub 
Next n
Range("C") = Range("B") ' тут нужно прописать, чтобы при "С" = 0 копировалось значение из столба "В"
End Sub

Sub DeleteRows()
LastRow = ActiveSheet.UsedRange.Row + ActiveSheet.UsedRange.Rows.Count
For Row = LastRow To 1 Step -1
On Error Resume Next
If Cells(Row, 12).Value = "Иванов Иван Иванович" Then ActiveSheet.Rows(Row).Delete
Next Row
End Sub

Set obj­Doc = GetO­b­ject (“D:\OpenMe.docx”) 

With ActiveWorkbook.Sheets("STRUCTURE").Range("A1")
    .PasteSpecial Paste:=xlPasteValues
    .PasteSpecial Paste:=xlPasteFormats
    .PasteSpecial Paste:=xlPasteColumnWidths
    
    Rows("77:146").Group 
End With

 ActiveWorkbook.SaveAs Application.DefaultFilePath & Application.PathSeparator & ThisWorkbook.Sheets("Лист1").Range("A50") & ".xls", FileFormat:=XlFileFormat.xlExcel8
    ActiveWorkbook.SendMail "ivanov@inbox.ru", ThisWorkbook.Sheets("Лист2").Range("c50")
    ActiveWorkbook.ChangeFileAccess xlReadOnly
 

    ActiveWorkbook.SendMail "ivanov@inbox.ru", ThisWorkbook.Sheets("Лист2").Range("c50") 

ThisWorkbook.Sheets("STRUCTURE").Range("A1:AA1000").Copy
With ActiveWorkbook.Sheets("STRUCTURE_Y").Range("A1")
    .PasteSpecial Paste:=xlPasteValues
    .PasteSpecial Paste:=xlPasteFormats
    .PasteSpecial Paste:=xlPasteColumnWidths
End With
 

Range("A50").Value = Application.InputBox("Заполнить отчет на дату:", "Сделайте выбор", "15.12.2012")

Dim New_Wb As Workbook
Set New_Wb = Workbooks.Add
New_Wb.Activate 
New_Wb.SaveAs ("D:\" & ThisWorkbook.Sheets("work").Range("A1") & ".xls")
New_Wb.Close
 

Sub New2()     
Dim New_Wb As Workbook     
Set New_Wb = Workbooks.Add     
New_Wb.Activate     
New_Wb.SaveAs ("D:\test" & "1" & ".xls")     
New_Wb.Close 
End Sub

Public Sub RemoveDigits()
    Static pReg As Object
    Dim Cell As Range
    If TypeOf Selection Is Range Then
        If pReg Is Nothing Then
            Set pReg = CreateObject("VBScript.RegExp")
            pReg.Global = True: pReg.Pattern = "\d"
        End If
        For Each Cell In Selection
            If Application.WorksheetFunction.IsText(Cell.Value) Then Cell.Value = pReg.Replace(Cell.Value, "")
        Next
    End If
End Sub 

Имя_для_сохранения = [A31]
    FName = Application.GetSaveAsFilename(InitialFileName:=Имя_для_сохранения, _
                                          FileFilter:="Excel Files (*.xls), *.xls", _
                                          Title:="Выберите имя файла для сохранения")
    If VarType(FName) <> vbBoolean Then ThisWorkbook.SaveAs FName