Option ExplicitPrivate Sub Worksheet_Change(ByVal Target As Range)Dim rng1 As RangeDim i As ByteIf Target.Count <> 1 Or Target.Column <> 1 Then Exit SubApplication.EnableEvents = FalseIf Target.Value <> "" ThenSet rng1 = Worksheets("лист2").Range("A:A").Find(What:=Target.Value, LookIn:=xlValues, LookAt _ :=xlPart, SearchOrder:=xlByColumns, SearchDirection:=xlNext, MatchCase:= _ False, SearchFormat:=False)If rng1 Is Nothing ThenApplication.EnableEvents = TrueExit SubEnd Ifi = 1Do While rng1.Offset(i, 0).Value = ""i = i + 1LoopSet rng1 = rng1.Resize(i, 7)rng1.Copy Destination:=TargetEnd IfApplication.EnableEvents = TrueEnd SubPrivate Sub Worksheet_SelectionChange(ByVal Target As Range)End Sub