Selection.Copy
ChDir "C:\Users\Oleg\Desktop"
Workbooks.Open Filename:="label.xlsx"

Range("D2").Select

Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats


ActiveWorkbook.Save

ActiveWorkbook.Close

Sub заменацвета()
'
' заменацвета
'

'
Application.FindFormat.Interior.ColorIndex = 4
Application.ReplaceFormat.Interior.ColorIndex = 3
Cells.Replace What:="", Replacement:="", LookAt:=xlPart, SearchOrder:= _
xlByRows, MatchCase:=False, SearchFormat:=True, ReplaceFormat:=True
End Sub

Sub Kopirovanie()

'
' Kopirovanie Макрос

'

'Выделить диапазон который необходимо скопировать
Range("Таблица1").Select
'Скопировать то, что выделено
Selection.Copy
ChDir "C:\Users\Oleg\Desktop"
Workbooks.Open Filename:="Книга2.xlsm"
'Выделить начальную ячейку в которую необходимо вставить скопированные данные
Range("A2").Select
'Вставить данные
ActiveSheet.Paste

'сохранить текущую книгу
ActiveWorkbook.Save
'Закрыть книгу
ActiveWorkbook.Close
End Sub

Sub nacait()

'
' nacait Макрос

'
Workbooks.Open Filename:= _
"C:\Users\Oleg\Desktop\Книга2й.xlsm"
Application.Wait Time:=Now + TimeValue("0:00:01")
Range("Таблица252").Select
    Selection.Copy
    Windows("Книга2й.xlsm").Activate
    Range("A2").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Columns("A:A").ColumnWidth = 11.86
    ActiveWorkbook.Save
    Windows("DATABASE (version609).xlsm").Activate
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim rngFind As Range
       
    If Target.CountLarge = 1 Then
        If Not Intersect(Target, Columns("D")) Is Nothing Then
            Set rngFind = [A:A].Find(Target, , xlValues, xlWhole, , xlNext, False, False, False)
            If Not rngFind Is Nothing Then
                Application.EnableEvents = False
                Intersect([B:B], rngFind.EntireRow).Value = 2
                Application.EnableEvents = True
            End If
        End If
    End If
End Sub

    If Target.CountLarge = 1 Then
        If Not Intersect(Target, Columns("AC")) Is Nothing Then
            Set rngFind = [A:A].Find(Target, , xlValues, xlWhole, , xlNext, False, False, False)
            If Not rngFind Is Nothing Then
                Application.EnableEvents = False
                Intersect([C:C], rngFind.EntireRow).Value = 2
                Intersect([W:W], rngFind.EntireRow).Value = "2019"
                Intersect([X:X], rngFind.EntireRow).Value = Now
                Intersect([Y:Y], rngFind.EntireRow).Value = 0
                Intersect([C:C], rngFind.EntireRow).Interior.ColorIndex = 3
                Intersect([D:D], rngFind.EntireRow).Interior.ColorIndex = 2
                Intersect([Y:Y], rngFind.EntireRow).Interior.ColorIndex = 46
                Intersect([U:U], rngFind.EntireRow).Value = 1
                rngFind.Offset(0, 21) = "Розничный покупатель"
                rngFind.Offset(0, 3) = ""
                Application.EnableEvents = True
            End If
        End If
    End If

    If Target.CountLarge = 1 Then
        If Not Intersect(Target, Columns("AA")) Is Nothing Then
            Set rngFind = [A:A].Find(Target, , xlValues, xlWhole, , xlNext, False, False, False)
            If Not rngFind Is Nothing Then
                Application.EnableEvents = False
                Intersect([C:C], rngFind.EntireRow).Value = 2
                Intersect([W:W], rngFind.EntireRow).Value = Now
                rngFind.Offset(0, 21) = "розничный покупатель"
                Application.EnableEvents = True
            End If
        End If

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Count <> 1 Then Exit Sub
    If Target.Column <> 20 Then Exit Sub
    If Target <> 2 Then Exit Sub
    Rows(Target.Row).Copy Destination:=Sheets("Лист2").Rows(Sheets("Лист2").Cells(Rows.Count, 20).End(xlUp).Row + 1)
End Sub