Sub test()
Range("A2:C5").Copy
Range("A2:C5").PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False
End Sub

If dicHead.Item(i)(0) = HeadMes Then

If dicHead.Item(1)(0) = "Ошибка2" Then

Option Explicit
Dim A()
Public dic As Dictionary, dicHead As Dictionary
Public HeadCount As Long
Sub HeadMesAdd(HeadMes As String, AreMes As String, NoMes As String)
Set dicHead = CreateObject("Scripting.Dictionary")
'dicHead.CompareMode = 1
Set dic = CreateObject("Scripting.Dictionary")
'dic.CompareMode = 1
dicHead.Add HeadCount + 1, Array(HeadMes, AreMes, NoMes, 0) '1-общий заголовок, 2 - если будут сообщения, 2 - если не будет сообщений, 3 - колличество сообщений
dic.Add HeadCount + 1 & "_0", Array(HeadMes, AreMes, NoMes, "", "", "", "", "", "", "")
HeadCount = HeadCount + 1
End Sub

Sub MesAdd(HeadMes As String, HM1 As String, HM2 As String, HM3 As String, HM4 As String, HM5 As String, HM6 As String, HM7 As String, HM8 As String, HM9 As String, HM10 As String)
Dim i As Long
For i = 1 To dicHead.Count
      If dicHead.Item(i)(0) = HeadMes Then
      dicHead.Item(i)(3) = dicHead.Item(i)(3) + 1
      dic.Add i & "_" & dicHead.Item(i)(4), Array(HM1, HM2, HM3, HM4, HM5, HM6, HM7, HM8, HM9, HM10)
      Exit For
      End If
Next i
End Sub

If A(i, j) = Empty Then msgbox "Элемент пуст" 'не подходит т.к. "" считается за Empty
If Not Not A(i, j) Then msgbox "Элемент пуст" 'Ругается на разность типов данных

Sub test()
Dim c As Range
For Each c In Range("A1:A10")
      If Range(c.Address).Row = 10 Then c = Range(c.Address).Offset(-1, 0)
Next c
End Sub

Sub test1()
Dim x As Double
x = 1.1234
If (x * 10000) - Fix((x * 10000)) <> 0 Then MsgBox "Ошибка"
End Sub

Sub test2()
Dim x As Double, y As Double
x = 1.1234
y = x * 10000
If y - Fix(y) <> 0 Then MsgBox "Ошибка"
End Sub

Private Sub Worksheet_Change()
 If Columns("E:F").EntireColumn.Hidden = True Then
      Shapes("Стрелка вверх 1").Visible = True
 Else
      Shapes("Стрелка вверх 1").Visible = False
 End If
End Sub

avFiles = Application.GetOpenFilename("Excel files(*.xls*),*.xls*", , "Выбор файлов", , True)

Sub ZamenaListov_1()
Dim i As Long
Dim tb As Workbook, Donorb As Workbook, Acceptorb As Workbook
Dim sFilesDonor As String, sFilesAcceptor As String

For i = 1 To 4
sFolderDonor = ThisWorkbook.Worksheets("Свод").Cells(4 + i, 2)  'папка с донорами
If sFolderDonor <> "" Then
      sFolderAcceptor = ThisWorkbook.Worksheets("Свод").Cells(10 + i, 2)  'папка с акцепторами
      If sFolderAcceptor <> "" Then
            sFolderDonor = sFolderDonor & IIf(Right(sFolderDonor, 1) = Application.PathSeparator, "", Application.PathSeparator)
            sFolderAcceptor = sFolderAcceptor & IIf(Right(sFolderAcceptor, 1) = Application.PathSeparator, "", Application.PathSeparator)
            sFilesDonor = Dir(sFolderDonor & "*.xls*")
            sFilesAcceptor = Dir(sFolderAcceptor & "*.xls*")
            Do While sFilesDonor <> ""
                  Do While sFilesAcceptor <> ""
                        If sFilesDonor = sFilesAcceptor Then
                              Set tb = ThisWorkbook
                              Set Donorb = Application.Workbooks.Open(sFolderDonor & sFilesDonor, UpdateLinks:=0)
                              'что нибудь делаем
                              Donorb.Close False
                        End If
                        sFilesAcceptor = Dir
                  Loop
                  sFilesDonor = Dir
            Loop
      End If
End If

sFolderDonor = ""
sFolderAcceptor = ""
sFilesDonor = ""
sFilesAcceptor = ""
Next i
End Sub

Sub marker_columns()
For Each mcol In Selection.Columns
    Cells(1, mcol.Column) = 1
        For Each TSPcol In Cells(2, mcol.Column).Precedents 
        Cells(1, TSPcol.Column) = 1
        Next
    Next
End Sub

Sub signature()
Dim col1 As Long, col2 As Long
col1 = Selection.Cells(1).Column
col2 = Selection.Cells(Selection.Cells.Count).Column

For i = 1 To 1000
    Cells(1, col1 + i - 1) = 1
    If col1 + i > col2 Then
    Exit For
    End If
Next i
End Sub

Set objOutlookApp = CreateObject("Outlook.Application")
    objOutlookApp.Session.Logon
    Set objMail = objOutlookApp.CreateItem(0)   'создаем новое сообщение
    If Err.Number <> 0 Then Set objOutlookApp = Nothing: Set objMail = Nothing: Exit Sub 'если не получилось создать приложение или экземпляр сообщения - выходим
 
    sTo = Range("C4").Value    'Кому
    sSubject = Range("C6").Value   'Тема письма
    sBody = Range("C7").Value    'Текст письма
       
        With objMail    'создаем сообщение
        .To = sTo   'адрес получателя
        .CC = Range("C5").Value
        .Subject = sSubject   'тема сообщения
        '.Body = ???  'отключил, текст вшит в НТМЛсообщение
        .BodyFormat = olFormatHTML   'формат HTML
        .HTMLBody = Range("C7").Value & SheetToHTML(ThisWorkbook.Worksheets("Доставка (2)"))
        .Attachments.Add sAttachment
        .Display   'Display, если необходимо просмотреть сообщение, а не отправлять без просмотра, '.Send 'отправлять без просмотра
    End With

   If delra Is Nothing Then Set delra = ra Else Set delra = Union(delra, ra)      ' добавляем столбец в диапазон для удаления

Sub DeleteRowsAndColumns123()
Dim ra As Range, delra As Range, DeleteRow As String, DeleteColumn As String     'как обычно, задаем переменные
    
DeleteRow = "Удалить строку"       ' удаляем строки с таким текстом
DeleteColumn = "Удалить столбец"       ' удаляем столбцы с таким текстом
    
For Each ra In ActiveSheet.UsedRange.Rows      ' перебираем все строки в используемом диапазоне листа
If Not ra.Find(DeleteRow, , 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.Delete       ' если подходящие столбцы найдены - удаляем их
    
For Each ra In ActiveSheet.UsedRange.Columns       ' перебираем все столбцы в используемом диапазоне листа
If Not ra.Find(DeleteColumn, , 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.EntireColumn.Delete       ' если подходящие строки найдены - удаляем их
End Sub