Добавление строк по условию

Private Sub Worksheet_Change(ByVal Target As Range)
Me.ListObjects.Item(1).Range.AutoFilter Field:=4, Criteria1:="<>"
End Sub

Private Sub Worksheet_Activate()
Me.ListObjects.Item(1).Range.AutoFilter Field:=4, Criteria1:="<>"
End Sub

Private Sub Worksheet_Activate()
Dim sh As Worksheet, sh2 As Worksheet, arr, arr2, i As Long, n As Long, x As Long, k As Long, lr As Long, lr2 As Long
Set sh = Worksheets("Прайс"): Set sh2 = Worksheets("Прайс2")
lr = sh.Cells(Rows.Count, 1).End(xlUp).Row
lr2 = sh2.Cells(Rows.Count, 1).End(xlUp).Row
arr = sh.Range("A1:G" & lr)
k = Application.WorksheetFunction.CountIf(sh.Columns(4), "<>" & "")
ReDim arr2(1 To k, 1 To 7): x = 1
For i = LBound(arr) To UBound(arr)
    If Not IsEmpty(arr(i, 4)) Then
        For n = 1 To 7
            arr2(x, n) = arr(i, n)
        Next n
        x = x + 1
    End If
Next i
If lr2 >= 4 Then sh2.Range("A4:G" & lr2).Clear
sh2.Range("A4").Resize(UBound(arr2), 7) = arr2
End Sub

Set sh2 = Worksheets("Прайс2")

Private Sub Worksheet_Activate()
Me.ListObjects.Item(1).Range.AutoFilter Field:=4, Criteria1:="<>"
End Sub