Sub Копирование()
      Dim iBeginRange As Object, lCalc As Long, avArr, lr As Long, t As Single, cell, last As Range
      Dim sRngAddress As String, oAwb, j As String, sCopyAddress As String, sSheetName As String
      Dim lLastrow As Long, lLastRowMyBook As Long, li As Long, iLastColumn As Integer
      Dim wsSh As Object, wsDataSheet As Object, bPolyBooks As Boolean, avFiles
      If MsgBox("Выбрать файлы из которых будет формироваться ОС 14?", vbInformation + vbYesNo, "Excel-VBA") = vbYes Then
          avFiles = Application.GetOpenFilename("Excel files(*.xls*),*.xls*", , "для заполнения", , True)
          If VarType(avFiles) = vbBoolean Then Exit Sub
          t = Val(InputBox("Введите расчётный курс валюты", "курс евро"))
          If t = 0 Then t = 1
          bPolyBooks = True
      Else
          avFiles = Array(ThisWorkbook.FullName)
      End If
      With Application
          lCalc = .Calculation
          .ScreenUpdating = False: .EnableEvents = False: .Calculation = xlManual
      End With
      Set wsDataSheet = ThisWorkbook.ActiveSheet
      For li = LBound(avFiles) To UBound(avFiles)
          If bPolyBooks Then Workbooks.Open Filename:=avFiles(li)
          oAwb = Dir(avFiles(li), vbDirectory)
          Workbooks(oAwb).Sheets("Attachment to Invoice").Activate
          avArr = Range("C4:N2000").Value    'выбор диапозона значений в исходном листе
          For lr = 1 To UBound(avArr, 1)
              For i = 9 To 2000
                  If ThisWorkbook.Sheets("Лист2").Cells(i, 1) = "" Then
                      ThisWorkbook.Sheets("Лист2").Cells(i, 1) = avArr(lr, 8)
                      ThisWorkbook.Sheets("Лист2").Cells(i, 35) = avArr(lr, 4)
                      ThisWorkbook.Sheets("Лист2").Cells(i, 17) = avArr(lr, 5)
                      ThisWorkbook.Sheets("Лист2").Cells(i, 53) = avArr(lr, 11)
                      ThisWorkbook.Sheets("Лист2").Cells(i, 59) = avArr(lr, 12)
                      i = i + 1:
                      Exit For
                  End If
              Next i
          Next lr

      Next

      If bPolyBooks Then Workbooks(oAwb).Close False
      Range("Q9:Q1000").Replace What:="m", Replacement:="м", LookAt:=xlWhole
      Range("Q9:Q1000").Replace What:="pc", Replacement:="шт", LookAt:=xlWhole
      Range("Q9:Q1000").Replace What:="set", Replacement:="компл", LookAt:=xlWhole
      For Each cell In Range("BA9:BA1000")
          If IsNumeric(cell.Value) And cell.Value <> "" Then
              ' Умножаются только ячейки, содержащие числовые данные
              cell.Value = cell.Value * t

          End If
      Next

      For Each cell In Range("BG9:BG1000")
          If IsNumeric(cell.Value) And cell.Value <> "" Then
              ' Умножаются только ячейки, содержащие числовые данные
              cell.Value = cell.Value * t

          End If
      Next
End Sub