Private Sub Workbook_Open()
 Application.ScreenUpdating = False
 Application.Calculation = xlCalculationManual
 Dim ws1 As Worksheet, ws2 As Worksheet
 Dim lLastRow1 As Long, lLastRow2 As Long, n As Long
 Dim fcell As Range, lLastRow2new As Long

  Set ws1 = Sheets("Лист1")
  Set ws2 = Sheets("Лист2")
  lLastRow1 = ws1.Cells(Rows.Count, 21).End(xlUp).Row
  lLastRow2 = ws2.Cells(Rows.Count, 21).End(xlUp).Row

  ws1.Range("AA3:AA" & lLastRow1 + 1).FormulaR1C1 = "=RC[-5]&RC[-1]"
  ws2.Range("AA3:AA" & lLastRow2 + 1).FormulaR1C1 = "=RC[-5]&RC[-1]"

 For n = 3 To lLastRow1 + 1
  If ws1.Cells(n, 27) <> "" Then
   Set fcell = ws2.Range("AA3:AA" & lLastRow2 + 1).Find(ws1.Cells(n, 27), LookIn:=xlValues)
    If fcell Is Nothing Then
     lLastRow2new = ws2.Cells(Rows.Count, 21).End(xlUp).Row
     ws1.Range(ws1.Cells(n, 21), ws1.Cells(n, 26)).Copy ws2.Cells(lLastRow2new + 1, 21)
    End If
  End If
 Next

  lLastRow1 = ws1.Cells(Rows.Count, 33).End(xlUp).Row
  lLastRow2 = ws2.Cells(Rows.Count, 33).End(xlUp).Row

 For n = 3 To lLastRow1 + 1
  If ws1.Cells(n, 38) <> "" Then
   Set fcell = ws2.Range("AL3:AL" & lLastRow2 + 1).Find(ws1.Cells(n, 38), LookIn:=xlValues)
    If fcell Is Nothing Then
     lLastRow2new = ws2.Cells(Rows.Count, 33).End(xlUp).Row
     ws1.Range(ws1.Cells(n, 33), ws1.Cells(n, 38)).Copy ws2.Cells(lLastRow2new + 1, 33)
    End If
  End If
 Next

ws1.Range("AA3:AA" & lLastRow1 + 1).ClearContents
ws2.Range("AA3:AA" & lLastRow2 + 1).ClearContents

Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
End Sub