Sub NewRows()
Dim i As Long '
Dim x As Range, rngPast As Range

With Worksheets(1).Columns(1)
    For i = 2 To .Cells(.Rows.Count).End(xlUp).Row
    Set x = Worksheets(2).Columns(1).Find(.Cells(i), LookIn:=xlValues, lookat:=xlPart)
    If x Is Nothing Then
    .Cells(i).Copy
    
    Set rngPast = (Worksheets(1).Range("a" & Rows.Count).End(xlUp).Offset(1))
    rngPast.PasteSpecial (xlPasteAll)
    End If
    Next i
End With
End Sub

Sub Send_D()
    Dim objOutlookApp As Object, objMail As Object

    Application.ScreenUpdating = False
        On Error Resume Next 'пробуем подключиться к Outlook, если он уже открыт
        Set objOutlookApp = GetObject(, "Outlook.Application")
        Err.Clear 'Outlook закрыт, очищаем ошибку
        If objOutlookApp Is Nothing Then
    Set objOutlookApp = CreateObject("Outlook.Application")
    End If
    Set objMail = objOutlookApp.CreateItem(0)   'создаем новое сообщение
    'если не получилось создать приложение или экземпляр сообщения - выходим
    If Err.Number <> 0 Then Set objOutlookApp = Nothing: Set objMail = Nothing: Exit Sub

 
    With objMail 'создаем сообщение
        .To = ""
        .CC = ""
        '.BCC = ""
        .Subject = " Weekly PDCA" 
      .HTMLBody = "<p style='font-family:Calibri Light;font-size:13'>" & "Добрый день." & vbNewLine & "Ниже результаты за текущую неделю." & vbCrLf & _
                    "<p style='font-family:Calibri Light;font-size:13'>" & "" & vbNewLine & _
                    "<b><p style='font-family:Calibri Light;font-size:13'>   Files location at NPI Library: <br>" & vbCrLf & _
                    "       -    EE Weekly file  - " & Link1 & " <br>" & _
                    "       -    Inventory Snapshots  - " & Link2 & " <br>" & _
                    "       -    Weekly NPI  - " & Link3 & " <br>" & _
                    "<p style='font-family:Calibri Light;font-size:13'> Whole portfolio s</b>"
        .Display '.Send если необходимо просмотреть сообщение, а не отправлять без просмотра
     End With
     Set objOutlookApp = Nothing: Set objMail = Nothing
    Application.ScreenUpdating = True
End Sub

Private Function SubStr(r As Range, n As Integer, Del As String) As String
Application.Volatile
SubStr = Split(r.Value, Del)(n - 1)
End Function
-----
Sub ПереносЗначений() '
Dim n&
Application.ScreenUpdating = False
Application.EnableEvents = False
Worksheets("Report").Activate
With ActiveSheet
n = .Cells(Rows.Count, 1).End(xlUp).Row + 1 ' строка после последней пустой
.Cells(n, 3).Value = Worksheets("List").Cells(2, 3).Value
.Cells(n, 4).Value = Worksheets("List").Cells(1, 1).Value
.Cells(n, 5).Value = Worksheets("List").Cells(3, 3).Value
.... и др.
Application.EnableEvents = True
End With
End Sub

With ActiveSheet 
n = .Cells(Rows.Count, 1).End(xlUp).Row ' 
For i = n To 2 Step -1 
If Val(Cells(i, 14)) >= 0 Then     'удяляем нулевые 
Rows(i).Delete 
End If 
Next 
End With 

Sub Test()   '
With ActiveSheet
    i = .Cells(Rows.Count, 5).End(xlUp).Row '
    j = .Cells(Rows.Count, 7).End(xlUp).Row '
        With Range("H3:H" & j)
        .Cells(1).FormulaArray = "=MAX(IF(D$3:D$" & i & "=G3,IF(C$3:C$" & i & "=H8, E$6:E$" & i & ")))" '
        .Cells(1).Copy Range(.Cells(2), .Cells(.Cells.Count))
        .Value = .Value
        End With
   End With
   End Sub

Sub test()
Dim Str As String, Kolvo1, Kolvo2 As Double

Str = 1
Kolvo1 = 1
Kolvo2 = 7

Worksheets("Лист8").Cells(1, 1).FormulaLocal = "=ТЕКСТ(" & Kolvo1 & ";""##0"") & "":"" & ТЕКСТ(" & Kolvo2 & ";""##0"")" '
If Kolvo1 = 0 Then
Worksheets("Лист8").Cells(2, 1).Value = "TP = 0" '
ElseIf Kolvo2 = 0 Then
Worksheets("Лист8").Cells(2, 1).Value = "SL = 0"
Else
Worksheets("Лист8").Cells(2, 1).FormulaLocal = "=ТЕКСТ(" & Str & ";""#0"") & "" : "" & ТЕКСТ(" & Kolvo1 / Kolvo2 & ";""0.##"")"
End If
End Sub

Dim err As Range
i = .Cells(Rows.Count, "A").End(xlUp).Row

For Each err In Range("A$6:A$" & i)
If err.Value = 0 Then '
Cells(err).Offset(err, 1).Value = "нет"
End If
Next