Sub Копирование_Вставка_Очистка()
    Range("H2:L" & lr2).Copy
    Range("AA2").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
     Range("A1").PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
    Range("A7:F7").ClearContents
End Sub

Sub Button1_Click()
    With Sheets("Лист2")
        Range("B4:L4").Copy .Range("B" & .Cells.SpecialCells(xlLastCell).Row + 1)
    End With
End Sub

Sub Макрос()
    For i = 1 To Cells(Rows.Count, 1).End(xlUp).Row
        With Sheets("Лист2")
            s = .Cells.Find(What:=Cells(i, 1), After:=ActiveCell, LookIn:=xlFormulas, LookAt _
                :=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
                False, SearchFormat:=False).Address
            Cells(i, 2).Hyperlinks.Add Anchor:=Range("B" & i), Address:="", SubAddress:= _
                "'" & .Name & "'!" & s, TextToDisplay:=Cells(i, 1).Value
        End With
    Next
End Sub

=MAX(IF($B$2:$B$12=B2;$C$2:$C$12;))=C2

Dim factor As Byte
Dim arr(), nmb, art, i As Long
with sheets("Имя вашего листа")
arr = .Range("B3:E" & .Cells(.Rows.Count, "B").End(xlUp).Row).Value
    nmb = CDbl(usf_____.txt_____)
    art = CDbl(usf_____.txt______)
    factor = 1
    For i = 1 To UBound(arr)
        If arr(i, 1) = nmb Then
            If arr(i, 4) = art Then
            .Cells(i + 2, "J") = .Cells(i + 2, "J") + usf_____.txt______.Value
            .Cells(i + 2, "K") = .Cells(i + 2, "K") + usf______.txt____.Value
            factor = 0
            Exit For
            End If
        End If
    Next
    If factor Then MsgBox "Не нашел позицию!" Else MsgBox "Добавил!"
end with

str2 = "*" & sheet1.Cells(i, 4).Value & "*"

Dim FilesToOpen
    FilesToOpen = Application.GetOpenFilename _
        ("Excel files(*.xls*),*.xls*", 1, "Выбрать файл", , False)
    If TypeName(FilesToOpen) = "Boolean" Then
        MsgBox "Файл не выбран!"
        Exit Sub
    End If
    Workbooks.Open Filename:=FilesToOpen