Sub Extract_data()
Application.ScreenUpdating = False

Dim rngA As Range, rngS As Range, rngCond As Range, Cond As Range, Cond0 As Object

Dim Nc As Long, Nr As Long
Dim sht670 As Worksheet
Dim LastRow As Long, Rw As Long, i As Long

Set sht670 = Worksheets("670")
Set rngS = sht670.Range("A1")
Set rngA = rngS.CurrentRegion
Nr = rngA.Rows.Count
Nc = rngA.Columns.Count
Set Cond0 = Worksheets("Support").Range("B3")
Cond0.FormulaR1C1 = "=MONTH(R[-1]C)&""/""&YEAR(R[-1]C)"
Cond0.Copy
Cond0.PasteSpecial (xlPasteValues)
Set Cond0 = Worksheets("Support").Range("B3")


Set rngCond = rngS.Offset(1, Nc)
Set rngCond = rngCond.Resize(Nr, 1)
rngCond.FormulaR1C1 = "=MONTH(RC[-1])&""/""&YEAR(RC[-1])"
rngCond.Copy
rngCond.PasteSpecial (xlPasteValues)


sht670.Activate
LastRow = Cells(Rows.Count, 1).End(xlUp).Row    'последняя строка выгрузки
With Sheets("Тех")
    Rw = .Cells(Rows.Count, 1).End(xlUp).Row + 1        'выделение массива
    Range(.Cells(5, 1), .Cells(Rw + 1, 20)).ClearContents   'очистка листа
    Rw = 2                                                 'строка с которой начинаем копировать
        For i = 2 To LastRow
            If Cells(i, 10) = "Aрхив" Then
                    If Cells(i, 21) = Cond0 Then
                    Range(Cells(i, 1), Cells(i, 20)).Copy .Cells(Rw, 1)
                    Rw = Rw + 1
               End If
            End If
        Next
End With

'Call Extract_columns
'Worksheets("Вывод").Activate
'Call increment
'Call podpis

Application.ScreenUpdating = True
MsgBox "Обработка завершена успешно."
End Sub