Как разделить .xlsx по строкам?

Как сохранить ширину строк исходной таблицы? Также как сохранить заголовок во всех файлах? При выборе "2" заголовок не сохраняется.
Заранее спасибо

kolyayolo, благодарю за замечание (обновил код), и хороший вопрос.
Для переноса ширины колонок нужно после объявления переменных сохранить значения ширины колонок в массив:

ReDim colWidth(Cells.SpecialCells(xlLastCell).Column)
  For Count = 1 To UBound(colWidth) ' Читаем ширину колонок
    colWidth(Count) = Cells(1, Count).ColumnWidth
  Next Count

Затем, после вставки данных перенести значения ширины колонок из массива:

' Пишем ширину колонок
    Cells(1, 1).Resize(1, UBound(colWidth)).ColumnWidth = colWidth

Добрый день!

Спасибо за решение, искал везде, ваш подошел идеально! Единственный вопрос - а как сделать, чтобы полученные таблицы-файлы были "упакованы" в умные таблицы на выходе? Я не силен в VBA, подскажете какой код и куда его вписать?

Добавил код, который добавляет умную таблицу к диапазону, но есть проблема. У меня файлы формируются из заранее подготовленной умной таблицы, т.е. она разбивается на части. И этот (ваш) код получается формирует файлы с не отформатированными диапазонами, а последний файл именно форматируется в умную таблицу (как бы унаследует формат из исходного файла). Т.е. не все сформированные файлы с умными таблицами получаются, а только последний. А мне нужно, чтобы все были оформлены в умные таблицы. Я добавил код, который добавляет формат в полученные файлы, вот такое у меня получилось:

Option Explicit ' Обязательное объявление переменных
Option Base 1 ' Нижняя граница массива (по умолчанию)
'12345678901234567890123456789012345bopoh13@ya67890123456789012345678toster56789

Sub Border_Limit()
  Dim Limit As Integer, Count As Integer, SaveDir As String, SetTitle As Boolean

  Count = 1: Limit = 2001 ' Счётчик файлов; Количество строк
  SetTitle = True ' Если есть заголовок, заменить False на True
      
  SaveDir = "F:\ZeusCeramica\Веб-система\Руководитель\Спецификации" ' Или вписать полный путь для сохранения "F:\ZeusCeramica\Веб-система\Руководитель\Спецификации" или ThisWorkbook.Path
  ' Предполагается, что в колонке A нет пустых ячеек
  While Not IsEmpty(Cells(IIf(SetTitle, 2, 1), 1))
    Rows("1:" & Limit).Copy
    Workbooks.Add xlWBATWorksheet ' Создать новую книгу: шаблон с 1 листом
    ActiveSheet.Paste: Cells(1, 1).Select
    
    '-------Оформляем полученные таблицы в умные----------
    
    Dim a As Long
    'Определяем количество строк
        a = Cells(1, 1).CurrentRegion.Rows.Count
        'Создаем «умную» таблицу с сохранением первой строки заголовков
        ActiveSheet.ListObjects.Add(xlSrcRange, Range(Cells(1, 1), Cells(a, 17)), , xlYes).Name _
        = "TableRange"

    ActiveWorkbook.SaveAs Filename:=SaveDir & "\BOM_test_" & Count & ".xlsx", _
      FileFormat:=xlOpenXMLWorkbook
    ActiveWindow.Close
    Rows(IIf(SetTitle, 2, 1) & ":" & Limit).Delete Shift:=xlUp
    Count = Count + 1
   Wend: MsgBox "Файл разбит на " & Count - 1 & " файл(ов). "
End Sub

Но в результате получается ошибка, т.к. система пытается последнюю таблицу, которая "умная" тоже повторно оформить.
Подскажете, как подправить?

kolyayolo, alcompstudio, на технических ресурсах принято выражать свою положительную оценку кнопкой "Нравится", тем самым указывая на полезность материала.

Для создания умной таблицы для всего активного листа с именем "Table_1" используется следующий метод (четвёртый параметр указывает на наличие заголовков):

ActiveSheet.ListObjects.Add(, ActiveSheet.UsedRange, , xlYes).Name = "Table_1"

Для удаления единственной умной таблицы на активном листе используется метод:
ActiveSheet.ListObjects(1).Delete