Attribute VB_Name = "Module1"

Sub Заявка()
'
' Заявка Макрос
' Макрос записан 23.12.2013 (Юрченко Александр)
'

а = Range("Object1") ' АУП
b = Range("Object2") ' Объект
с = Range("Quatro") ' Квартал
d = Range("Position") ' Количество позиций в заявке
z = Range("Data") ' Дата заявки
q = Range("PositionEnd") + 1
For i = 0 To d - 1
      w = 12 + 2 * i ' строка заявки
      e = Cells(w, 3) ' Номенклатурная позиция
      f = Cells(w, 4) + " " + Cells(w + 1, 4) ' Наименование МТР
      g = Cells(w, 5) ' Количество
      h = Cells(w, 6) ' Единицы измерения
      j = Cells(w + 1, 7) ' Примечание
      Workbooks("Заявки ОМТО.xls").Activate
          Cells(q, 2) = b
          Cells(q, 6) = e
          '''''''''''''''
      Workbooks("План.xls").Activate
      q = q + 1
Next i
End Sub

Sub Заявка()
       Dim f As Boolean, wb As Workbook
       '
       ' Заявка Макрос
       ' Макрос записан 23.12.2013 (Юрченко Александр)
       On Error Resume Next
       Set b = Workbooks("Свод.xls")
       If Not b Is Nothing Then f = -1
        On Error goto 0
       Set wb = GetObject(ThisWorkbook.Path & "\Свод.xls")
       With ThisWorkbook
           а = .Range("Object1")    ' АУП
           d = .Range("Position")    ' Количество позиций в заявке
           z = .Range("Data")    ' Дата заявки
           q = .Range("PositionEnd") + 1
           For i = 0 To d - 1
               w = 12 + 2 * i    ' строка заявки
'            e = .Cells(w, 3)    ' Номенклатурная позиция
'            f = .Cells(w, 4) + " " + Cells(w + 1, 4)    ' Наименование МТР
'            g = .Cells(w, 5)    ' Количество
'            h = .Cells(w, 6)    ' Единицы измерения
'            j = .Cells(w + 1, 7)
'убрать нафиг все переменные и присваивать значения напрямую, как дальше:
               wb.Cells(q, 2) = .Range("Object2")    ' Объект
               wb.Cells(q, 6) = .Range("Quatro")     ' Квартал
               '...
               '''''''''''''''
               q = q + 1
           Next i
       End With
       If f Then
           wb.Save
       Else
           Windows("Свод.xls").Visible = -1
           wb.Close -1
       End If
End Sub