Страницы: 1
RSS
VBA. Сохранение листов в отдельные книги с условиями.
 
Доброго времени суток. Есть множество подобных вопросов, но не один из найденных макросов не отвечает заданным критериям.

Как сохранить в отдельные книги определенные листы?

1. Чтобы активация происходила кнопкой(предполагаю что через вставку фигуры).
2. Чтобы сохранились определенные активные листы(кнопка находится на первом листе, листы для сохранения на 3-4-5(может больше, может меньше) название у всех разное)
3. Чтобы название файлов было по названию листа
4. Чтобы путь сохранения файлов вставлялся в ячейку на первом листе
5. Чтобы данные которые находятся на сохраняемом листе были в виде текста(по аналогии "вставить как текст" (на страницах различные формулы, которые не нужны в отделенном листе)).

Буду благодарен за любые идеи, ссылку, наводку, либо ответ "Это 100% не возможно".
Изменено: Max Shams - 13.06.2020 10:48:03
 
Ищите информацию по каждому отдельному вопросу, монтируйте макрос )
 
Max Shams, в "Приемах" есть статья по Вашей задаче.
 
нужно цитировать (когда нужно), а не бездумно копировать [МОДЕРАТОР]

https://www.planetaexcel.ru/techniques/3/160/     тут ищите
 
Здравствуйте. Вот файл-пример.
 
Евген1788, зачем повторяться?
 
DANIKOLA, Больше спасибо.

Однако я нашёл схожий макрос, чуть его подправил, чтоб название файла так же вводилось в ячейку. Но не могу разобраться как сделать несколько файлов? Попробовал взять часть кода с Вашего макроса, но как-то не вышло. Может подскажите? Пример прикладываю.

P.S.
Файлов будет 4-5-6, путь один, названия разные. Название файлов сделаю сцепкой с других листов(может имеет значение).
 
Юрий М, Я внимательно просмотрел примеры, к сожалению они не совсем подходят под мои задачи, однако информацию почерпнул. Спасибо.
 
см.вложение
Программисты - это люди, решающие проблемы, о существовании которых Вы не подозревали, методами, которых Вы не понимаете!
 
Ігор Гончаренко,Возможно туплю, но куда указывать имена файлов 2-3 и т.д. листов?  
 
А2, В2 (путь, имя)
Изменено: Ігор Гончаренко - 15.06.2020 07:54:03
Программисты - это люди, решающие проблемы, о существовании которых Вы не подозревали, методами, которых Вы не понимаете!
 
Ігор Гончаренко, Возможно я непонятно объяснил, пытаюсь добиться расстановки как в примере.

Либо продолжаю тупить.
 
Код
Sub SaveSheet(ws As Worksheet, sPath As String)
  Dim sName As String, Sp As Shape, iFullName As String
  Application.DisplayAlerts = False
  sName = ws.Range("b2").Value
  If sName = "" Then
    MsgBox "Вы не указали имя файла.", 48, "Ошибка!"
    Application.DisplayAlerts = True: Exit Sub
  End If
  iFullName = sPath & sName & ".xlsx"
  If Dir(iFullName) <> "" Then
    MsgBox "Файл с таким именем уже существует. Попробуйте другой.", 64, "Для сведения."
  Else
    ws.Copy
    For Each Sp In ActiveSheet.Shapes
      Sp.Delete
    Next
    ActiveWorkbook.SaveAs Filename:=sPath & sName & ".xlsx", FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
    ActiveWindow.Close
  End If
  Application.DisplayAlerts = True
End Sub


Sub SaveWorksheets()
  Dim wsht As Worksheet, pt$
  pt = ThisWorkbook.Worksheets(1).[a2]
  For Each wsht In ThisWorkbook.Worksheets
    SaveSheet wsht, pt
  Next
End Sub
если путь один на всех, на остальніх листах достаточно в В2 вписать имя будущего файла
Программисты - это люди, решающие проблемы, о существовании которых Вы не подозревали, методами, которых Вы не понимаете!
 
Ігор Гончаренко, листы должны быть в разных файлах, не в одном.
 
не имею ничего против, и предложенный макрос не противоречит этому вашему желанию
Программисты - это люди, решающие проблемы, о существовании которых Вы не подозревали, методами, которых Вы не понимаете!
 
Ігор Гончаренко, Большое спасибо, дошло.

Данный макрос перебирает все листы, а как сделать, чтоб определенные? И возможно ли чтоб путь и название файлов указывались на одном листе для всех?
 
Код
Sub SaveSheet(ws As Worksheet, iFullName As String)
  Dim Sp As Shape
  Application.DisplayAlerts = False
  If Dir(iFullName) <> "" Then
    MsgBox "Файл с именем" & vbLf & iFullName & vbLf & _
    "уже существует. Попробуйте другой.", 64, "Для сведения."
  Else
    ws.Copy
    For Each Sp In ActiveSheet.Shapes
      Sp.Delete
    Next
    ActiveWorkbook.SaveAs Filename:=iFullName, FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
    ActiveWindow.Close
  End If
  Application.DisplayAlerts = True
End Sub


Sub SaveWorksheets()
  Dim r&, pt$
  With ThisWorkbook.Worksheets(1)
    pt = .[a2]: r = 3
    Do While Not IsEmpty(.Cells(r, 1))
      SaveSheet ThisWorkbook.Worksheets(.Cells(r, 2).Value), pt & .Cells(r, 1) & "xlsx"
      r = r + 1
    Loop
  End With
End Sub
если имена файлов записывать в А3 и далее, а имена соотв. листов в В3 и далее
Изменено: Ігор Гончаренко - 15.06.2020 10:21:00
Программисты - это люди, решающие проблемы, о существовании которых Вы не подозревали, методами, которых Вы не понимаете!
 
Ігор Гончаренко, Огромное спасибо, работает так как надо.  
Изменено: Max Shams - 15.06.2020 13:52:00 (был не прав)
Страницы: 1
Наверх