Private Sub Worksheet_Change(ByVal Target As Range)
    Dim KeyCells As Range
    Set KeyCells = Range("Таблица2[Столбец1]")
If Not Application.Intersect(KeyCells, Range(Target.Address)) _
Is Nothing Then
        Range(ActiveCell, ActiveCell.End(xlToRight)).Select
        Selection.Copy
        Selection.PasteSpecial Paste:=xlPasteValues
        Application.CutCopyMode = False
        ActiveCell.Offset(2, 0).Select
End If
End Sub

Sub AddSheetsOrder()
    Dim szTodayDate As String
    szTodayDate = Format(Date, "dd.mmm.yyyy")
    On Error GoTo MakeSheet
    Sheets(szTodayDate).Activate
    Exit Sub
MakeSheet:
    Sheets.Add , Worksheets(Worksheets.Count)
    ActiveSheet.Name = szTodayDate
    Sheets("Общая").Select
    Cells.Select
    Selection.Copy
    Sheets(szTodayDate).Select
    Cells.Select
    Selection.PasteSpecial Paste:=xlPasteAllUsingSourceTheme, Operation:=xlNone
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone
    Sheets("Общая").Select
    Selection.Cells(1).Select
    Application.CutCopyMode = False
    Sheets(szTodayDate).Select
    Cells.Select
    Range("A4").Select
    ActiveCell.FormulaR1C1 = "=IFERROR(IF(SUBTOTAL(3,RC[1]),R[-1]C+1,R[-1]C),1)"
    Range("A4").Select
    Selection.AutoFill Destination:=Range("A4:A83")
    Range("A4:A83").Select
    Range("A3:O3").Select
    Selection.AutoFilter
    ActiveSheet.Range("$A$3:$O$82").AutoFilter Field:=13, Criteria1:="<>"
    Range("C2").Select
    Selection.ClearContents
    Range("D:K").Select
    Selection.Delete Shift:=xlToLeft
    Range("A1").Select
End Sub