Добрый день! перебрал много форумов, но так и не сумел собрать "свой" макрос из разных кусков кодов, и поэтому оооочень нужна помощь в нарезке шаблонов файлов с именами из диапазона ячеек, с небольшим копипастом перед-этим есть файл, в нем много вкладок Необходим макрос, который будет: 1) Копировать из вкладки "Пути и имена" ячейку B2, вставлять значение во вкладку "Настройки" в ячейку A2 2) Сохранять копию книги через "Сохранить как" с именем из ячейки A2 из вкладки "Пути и имена", в формате .xlsx (без макросов) 3) В этой копии скрывать вкладку "Настройки", удалять вкладку "Пути и имена" 4) закрывать эту копию и дальше с п.1 заново цикл - скопировать из вкладки "Пути и имена" ячейку B3, вставить во вкладку "Настройки" в ячейку A2 ,сохранять копию книги через "Сохранить как" с именем из ячейки A3 из вкладки "Пути и имена", в формате .xlsx (без макросов), и далее п.3 и 4
и повторять цикл сохранения копий книги до первого пустого значения в столбце B вкладки "Пути и имена"
Sub main()
Dim arr(), i&
Dim lRow As Long
Dim mdBook As Workbook
Dim sht As Worksheet
lRow = Worksheets("Пути и имена").Range("a" & Worksheets("Пути и имена").Rows.Count).End(xlUp).Row
arr = Worksheets("Пути и имена").Range("b2:c" & lRow).Value
For i = 1 To UBound(arr)
Set mdBook = Workbooks.Add(1)
mdBook.Worksheets(1).Columns.AutoFit
Set sht = mdBook.Worksheets.Add(after:=mdBook.Worksheets(1))
sht.Name = "база"
Set sht = mdBook.Worksheets.Add(after:=sht)
sht.Name = "Прочее"
mdBook.Worksheets(1).Name = "Настройки"
mdBook.Worksheets(1).Range("a1").Value = "Путь"
mdBook.Worksheets(1).Range("a2").Value = arr(i, 1)
mdBook.SaveAs Filename:=arr(i, 1)
mdBook.Close True
Next i
End Sub
Nordheim написал: Доброго времени суток! А где то, что не получилось?
ну вот такой код я нарыл в интернет, но это разовое сохранение копии, мне главное запустить цикл сохранений многих копий все остальное на самом деле я могу сам другими макросами потом сделать - подставить значения. скрыть листы, удалить листы, а вот цикл - не могу понять, как помогите, пожалуйста!
Код
Sub SaveFile()
Dim CellValue As String
Dim Path As String
Dim FinalFileName As String
Application.DisplayAlerts = False
Path = ThisWorkbook.Path & "\"
CellValue = Range("B14")
FinalFileName = Path & CellValue
ActiveWorkbook.SaveAs FileName:=FinalFileName, _
FileFormat:=xlOpenXMLWorkbook
End Sub
ChubraevRO написал: но не срабатывает до конца - создает Лист 1
На какой строке ошибка, я проверял все отработало нормально Проверил на Excel2016, так же все отработало без ошибок. Первоначально код писал в Office365