Поиск  Пользователи  Правила 
Закрыть
Логин:
Пароль:
Забыли свой пароль?
Регистрация
Войти
 
Страницы: 1
RSS
Не получается сохранить листы в файл
 
Здравствуйте!
У меня не получается сохранить листы в файл, при этом чтобы при сохранении не было ни макросов, ни кнопок, ни формул
Есть книга, в ней несколько листов, но нужно сохранить только три, в папку с названием из ячейки и название  нового файла тоже из ячейки
Подскажите пожалуйста, что не так в моем макросе?
Код
Sub СохранитьЛистыВФайл1()
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Dim New_Wb As Workbook
    Set New_Wb = Workbooks.Add
    ThisWorkbook.Sheets(Array("сводная", "выводрем", "выводсм")).Copy
   New_Wb.Activate
New_Wb.SaveAs Filename:=Application.ThisWorkbook.Path & "\" & CStr(Range("L1")) & "\" & CStr(Range("M1")) & "\" & CStr(Range("N1")) & "\" & Range("O1") & ".xlsx", FileFormat:=51
ActiveSheet.Buttons.Delete
For Each cell In Sheets(Array("сводная", "выводрем", "выводсм")).UsedRange.Cells
   cell.Formula = cell.Value
Next cell

New_Wb.Close
Application.DisplayAlerts = True
Application.ScreenUpdating = True
MsgBox "Выполнено!"
End Sub
 
Код
Sub СохранитьЛистыВФайл1()
Application.ScreenUpdating = False
Application.DisplayAlerts = False

Dim Sh As Worksheet
ThisWorkbook.Sheets(Array("сводная", "выводрем", "выводсм")).Copy
With ActiveWorkbook
    For Each Sh In .Worksheets
        With Sh
            .UsedRange.Value = .UsedRange.Value
            .DrawingObjects.Delete
        End With
    Next
    .SaveAs Filename:=ThisWorkbook.Path & "\" & CStr(Range("L1")) & "\" & CStr(Range("M1")) & "\" & CStr(Range("N1")) & "\" & Range("O1") & ".xlsx"
    .Close True
End With
 
Application.DisplayAlerts = True
Application.ScreenUpdating = True
MsgBox "Выполнено!"
End Sub
Согласие есть продукт при полном непротивлении сторон.
 
пишет ошибку 1004 -  доступ к файлу невозможен...и выделяет строку
.SaveAs Filename:=ThisWorkbook.Path & "\" & CStr(Range("L1")) & "\" & CStr(Range("M1")) & "\" & CStr(Range("N1")) & "\" & Range("O1") & ".xlsx"

вот уже несколько дней с этим пытаюсь справиться... в моем макросе тоже самое пишет... (
 
Ктож знает что там в тех ячейках... Только Вы :)
 
Так у Вас существуют папки с названиями из ячеек, которые вы сцепляете? Лист с ячейками, из которых Вы берете названия папок/файла, в момент работы макроса должен быть АКТИВЕН. Или указывайте его явно
Изменено: Sanja - 1 Мар 2017 17:57:18
Согласие есть продукт при полном непротивлении сторон.
 
в ячейках адрес к папке.. диск д -работа - 2017 -и т. д.... но этот адрес находится только в книге, там где макрос... в новой книге  этих ячеек нет.. поэтому этот адрес нужно указать из основной книги.. а как это сделать не знаю..
и как раз макрос я запускаю с того листа где и этот адрес... в ячейках
Изменено: ALANA - 1 Мар 2017 18:01:55
 
Код
Sub СохранитьЛистыВФайл1()
Application.ScreenUpdating = False
Application.DisplayAlerts = False

Dim Sh As Worksheet
Dim nmSh As Worksheet
Set nmSh = ThisWorkbook.Worksheets("Лист1") 'лист, в ячейках которого названия папок и нового файла
ThisWorkbook.Sheets(Array("сводная", "выводрем", "выводсм")).Copy
With ActiveWorkbook
    For Each Sh In .Worksheets
        With Sh
            .UsedRange.Value = .UsedRange.Value
            .DrawingObjects.Delete
        End With
    Next
    .SaveAs Filename:=ThisWorkbook.Path & "\" & nmSh.Range("L1") & "\" & nmSh.Range("M1") & "\" & nmSh.Range("N1") & "\" & nmSh.Range("O1") & ".xlsx"
    .Close True
End With
 
Application.DisplayAlerts = True
Application.ScreenUpdating = True
MsgBox "Выполнено!"
End Sub
Согласие есть продукт при полном непротивлении сторон.
 
все хорошо! все получилось!)) большое Вам спасибо!!)
Изменено: ALANA - 1 Мар 2017 18:07:06
 
Цитата
ALANA написал: все равно то же самое
В Вашем скрытом 'Лист1' данные в столбцах A,B,C, а в путь Вы берете данные из ячеек столбцов L,M,N и O. Так задумано?
Согласие есть продукт при полном непротивлении сторон.
 
да, так было задумано) в последнем варианте я просто не исправила название листа ЛИСТ1 на свой лист) все хорошо  сейчас!) Вы избавили меня от головной боли))
 
16-ю строку можно чуть сократить
Код
.SaveAs Filename:=ThisWorkbook.Path & "\" & Join(nmSh.Range("L1:O1").Value, "\") & "\" & ".xlsx"
Согласие есть продукт при полном непротивлении сторон.
 
спасибо большое)) каждый раз, что то делая с макросами узнаю что то новое) Вы просто умничка, помогая таким как я лузерам)
Изменено: ALANA - 1 Мар 2017 18:31:27
Страницы: 1
Читают тему (гостей: 1)