Автор Тема: Excel VBA Макросы: Заголовок для каждого файла.  (Прочитано 155 раз)

Оффлайн Nastya

  • Посетитель форума
  • Сообщений: 2
Что нужно дописать в макрос, чтобы при его запуске в каждом новом файле был заголовок?

Макрос
Sub Border_Limit()
  Dim Limit As Integer, Count As Integer, SaveDir As String
 
  Count = 1: Limit = 20
  SaveDir =
  While Not IsEmpty(Cells(1, 1)) '
    Rows("1:" & Limit).Cut '
    Workbooks.Add xlWBATWorksheet
    ActiveSheet.Paste: Cells(1, 1).Select
    ActiveWorkbook.SaveAs Filename:=SaveDir & "\отчет_" & Count & ".xlsx", _
      FileFormat:=xlOpenXMLWorkbook
    ActiveWindow.Close
    Rows("1:" & Limit).Delete Shift:=xlUp '
    Count = Count + 1
  Wend: MsgBox "Файл разбит на " & Count - 1 & " файл(ов). "
End Sub

Оффлайн Администратор

  • Administrator
  • Сообщений: 1605
Макрос
Sub Border_Limit()
    Dim sh_src As Worksheet, sh_new As Worksheet
    Dim Limit As Integer, Count As Integer, SaveDir As String
   
   
    ' Присваиваем активному листу имя 'sh_src'. Далее в коде будем обращаться к листу по имени 'sh_src'.
        ' Может быть так будет удобнее.
    Set sh_src = ActiveSheet
   
    Limit = 20
    SaveDir = "C:\Users\User\Desktop"
    While Not IsEmpty(sh_src.Cells(1, 1))
        Count = Count + 1
        sh_src.Rows("1:" & Limit).Cut
       
        ' Создание пустого эксель-файла с одним листом и присвоение первому листу имени 'sh_new'.
            ' Далее в коде будем обращаться к этому листу по имени 'sh_new'.
        Set sh_new = Workbooks.Add(xlWBATWorksheet).Worksheets(1)
       
        ' Вставка скопированных данных и перемещение рамки-курсора в ячейку 'A1'.
        sh_new.Paste: sh_new.Cells(1, 1).Select
       
        ' Вставка заголовка.
        '1) Выход из режима копирования, чтобы вставить пустую строку, а не скопированные данные.
        Application.CutCopyMode = False
        '2) Вставка пустой строки для заголовка.
        sh_new.Rows(1).Insert
        '3) Сюда вписывайте текст заголовка.
            ' Например, запись в ячейку 'A1' текста 'Заголовок'.
        sh_new.Range("A1").Value = "Заголовок."
       
        ActiveWorkbook.SaveAs filename:=SaveDir & "\отчет_" & Count & ".xlsx", FileFormat:=xlOpenXMLWorkbook
        ActiveWorkbook.Close
        sh_src.Rows("1:" & Limit).Delete Shift:=xlUp
    Wend
    MsgBox "Файл разбит на " & Count & " файл(ов). "
End Sub

Оффлайн Nastya

  • Посетитель форума
  • Сообщений: 2
Получилось. Спасибо.