пож-та :)
Sub check_new_positions()
Dim r_prog As Integer
r_prog = prog
prog = 1
If r_prog <> 1 Then Application.ScreenUpdating = False
Dim barcol As Integer, nbook As String, rbook As String, basebook As String
barcol = ActiveCell.column
rbook = ActiveWorkbook.name
Workbooks.Open Filename:=bd_path & pack_name
basebook = ActiveWorkbook.name
Range("A1").Select
Range(Selection, Cells(ActiveCell.SpecialCells(xlLastCell).Row, 1)).Select
Selection.Copy
Workbooks.Add
nbook = ActiveWorkbook.name
ActiveSheet.Paste
ActiveCell.SpecialCells(xlLastCell).Select
ActiveCell.Offset(1, 0).Select
Dim erow As Long
erow = Selection.Row
Workbooks(rbook).Activate
Cells(1, barcol).Select
Range(Selection, Cells(ActiveCell.SpecialCells(xlLastCell).Row, barcol)).Select
Application.CutCopyMode = False
Selection.Copy
Workbooks(nbook).Activate
ActiveSheet.Paste
Range("B1").Select
Application.CutCopyMode = False
ActiveCell.FormulaR1C1 = "1"
Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Select
Selection.FillDown
Selection.Copy
Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlMultiply, _
SkipBlanks:=False, Transpose:=False
Columns("B:B").Select
Application.CutCopyMode = False
' Selection.Delete Shift:=xlToLeft
Range("B1").Select
ActiveCell.FormulaR1C1 = "1"
Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Select
Selection.DataSeries Rowcol:=xlColumns, Type:=xlLinear, Date:=xlDay, _
Step:=1, Trend:=False
Range("A2").Select
Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Select
Selection.Sort Key1:=Range("A2"), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
Range("C2").Select
ActiveCell.FormulaR1C1 = _
"=IF(AND(RC[-2]<>0,ISNUMBER(RC[-2]),RC[-2]<>R[-1]C[-2]),7)"
Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Select
Selection.FillDown
' Cells(1, 5).FormulaR1C1 = "=INDEX([" & wpbar & "]Âîññòàíîâë_Ëèñò1!C1,MATCH(RC[-4],[" & wpbar & "]Âîññòàíîâë_Ëèñò1!C2,0))"
Columns("C:C").Select
Selection.Copy
Range("D1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
Columns("C:C").Select
Selection.Delete (xlShiftToLeft)
Range("A2").Select
Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Select
Selection.Sort Key1:=Range("b2"), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
Range(Cells(2, 1), Cells(erow - 1, 3)).Select
Selection.Delete Shift:=xlUp
Range(Cells(1, 1), ActiveCell.SpecialCells(xlLastCell)).Select
Selection.AutoFilter
Selection.AutoFilter Field:=3, Criteria1:="=7", Operator:=xlAnd
Selection.Copy
Sheets.Add
ActiveSheet.Paste
Call add_new_positions
If r_prog <> 1 Then
Application.ScreenUpdating = True
End If
prog = r_prog
End Sub
