Sub Button2_Click()
Dim i As Long
Dim iLastRow As Long
Dim iLR As Long
Dim Ord As Worksheet
Dim FoundИзделие As Range
Dim Kol_vo As Integer
  Set Ord = ThisWorkbook.Worksheets("order")
   iLR = Ord.Cells(Ord.Rows.Count, 3).End(xlUp).Row + 1
   Ord.Range(Ord.Cells(4, 2), Ord.Cells(iLR, 7)).ClearContents
With Worksheets("parts")
     iLastRow = Cells(Rows.Count, 3).End(xlUp).Row
  For i = 3 To iLastRow
    If Cells(i, 2) <> 0 Then
      Kol_vo = Cells(i, 2)
      Set FoundИзделие = .Columns(2).Find(Cells(i, 3), , xlValues, xlWhole)
       If Not FoundИзделие Is Nothing Then
          FAdr = FoundИзделие.Address
        Do
          iLR = Ord.Cells(Ord.Rows.Count, 3).End(xlUp).Row + 1
          .Range(.Cells(FoundИзделие.Row, 2), .Cells(FoundИзделие.Row, 7)).Copy Ord.Cells(iLR, 2)
          Ord.Cells(iLR, 4) = Ord.Cells(iLR, 4) * Kol_vo 'кол.деталей
          Ord.Cells(iLR, 7) = Ord.Cells(iLR, 7) * Kol_vo 'цена
          Set FoundИзделие = .Columns(2).FindNext(FoundИзделие)
        Loop While FoundИзделие.Address <> FAdr
       End If
    End If
  Next
End With
   Ord.Activate
End Sub