Sub Test()
  
  Dim Rng As Range, v()
  
  ' Задать тестовый диапазон ячеек
  Set Rng = Range("A1:A2")
  
  ' Записать в A1:A2 тестовый текст с начальными нулями
  Rng.Value = "0450000400"
  
  ' Считать текст в VBA-массив
  v() = Rng.Value
  
  ' Убедиться, что начальные нули в vba-массиве есть (т.е. там текст)
  Debug.Print v(1, 1), v(2, 1)
  
  ' Чтобы скопировать массив  v() в другой диапазон B1:B2, и чтобы нули остались,
  ' нужно сначала задать текстовый формат ячейкам назначения
  Rng.Offset(0, 1).NumberFormat = "@"
  
  ' В ячейки B1:B2 будет "выгружен" текст из v() с начальными нулями, а не числа без начальных нулей
  Rng.Offset(0, 1).Value = v()
  
  ' Теперь можно восстановить в B1:B2, например, общий формат, начальные нули при этом останутся
  Rng.Offset(0, 1).NumberFormat = "General"
  
End Sub

Sub qqq()
  Dim rng As Range, v()
  Set rng = Range("a2:a5")
  v() = FormattedValue(rng)
  rng.Offset(0, 1).NumberFormat = "@"
  rng.Offset(0, 1).Value = v()
  rng.Offset(0, 1).NumberFormat = "General"
End Sub

Sub export()
Dim oWb As Workbook
Dim x1 As Range, x2 As Range, x3 As Range
Dim lstr%, i&, n&, ii&
Set oWb = ActiveWorkbook
'Задаём объекты (ссылки на диапазоны данных) в файле источнике
Set x1 = Range([b17], Cells([b17].End(xlDown).Row, 2 - 1))  
Set x2 = Range([g17], Cells([g17].End(xlDown).Row, 7))
Set x3 = Range([m17], Cells([m17].End(xlDown).Row - 1, 13))
Workbooks.Open FileName:="F:\Логистика\Шаблон заказа поставщику.XLS" 'Открываем шаблон
With Sheets("Шаблон")
 .Range("A:L").ClearContents 'Чистим дипазоны в шаблоне
 Columns(7).Interior.ColorIndex = xlNone
 Columns(1).NumberFormat = "@"
 [a1].Resize(x1.Cells.Count, 1).Value = x1.Value
 [h1].Resize(x2.Cells.Count, 1).Value = x2.Value
 [i1].Resize(x3.Cells.Count, 1).Value = x3.Value
End With
end sub

Sub export()
    Dim oWb As Workbook
    Dim x1 As Range, x2 As Range, x3 As Range
    Dim lstr%, i&, n&, ii&
    Set oWb = ActiveWorkbook
    'Задаём объекты (ссылки на диапазоны данных) в файле источнике
    Set x1 = Range(Cells(17, "B"), Cells(17, "B").End(xlDown).Offset(-1))
    Set x2 = x1.Offset(, 5)
    Set x3 = x1.Offset(, 11)
'    Set x1 = Range([b17], Cells([b17].End(xlDown).Row, 2 - 1))
'    Set x2 = Range([g17], Cells([g17].End(xlDown).Row, 7))
'    Set x3 = Range([m17], Cells([m17].End(xlDown).Row - 1, 13))
    Workbooks.Open Filename:="F:\Логистика\Шаблон заказа поставщику.XLS"    'Открываем шаблон
    With Sheets("Шаблон")
    With Sheets(2)
        .Range("A:L").ClearContents    'Чистим дипазоны в шаблоне
        .Columns(7).Interior.ColorIndex = xlNone
'        .Columns(1).NumberFormat = "@"
        Dim arr(): arr() = x1.Value
        For i = LBound(arr) To UBound(arr)
            arr(i, 1) = "'" & Format(arr(i, 1), "0000000000")
        Next
        .[a1].Resize(x1.Cells.Count, 1).Value = arr
        ' [a1].Resize(x1.Cells.Count, 1).Value = x1.Value
        .[h1].Resize(x2.Cells.Count, 1).Value = x2.Value
        .[i1].Resize(x3.Cells.Count, 1).Value = x3.Value
    End With
End Sub

Dim arr(): arr() = x1.Formula
        For i = LBound(arr) To UBound(arr)
            arr(i, 1) = "'" & CStr(arr(i, 1))

Set x1 = Range(Cells(17, "B"), Cells(17, "B").End(xlDown).Offset(-1))
Set x2 = x1.Offset(, 5)
Set x3 = x1.Offset(, 11)
..
...
[h1].Resize(x2.Cells.Count, 1).Value = x2.Value
[i1].Resize(x3.Cells.Count, 1).Value = x3.Value
End With
lstr = Cells(Rows.Count, 8).End(xlUp).Row
If [h1] = 0 Then MsgBox "Неправильно выбран поставщик", , Error: Exit Sub
     For i = 1 To lstr
        Cells(i, 1) = x1(i, 1).Text
...........