mail mail
Нужен макрос для Excel?
Сделайте заказ прямо сейчас!
Ищете готовое решение?
Выбирайте и покупайте!
У вас есть интернет-магазин?
Настроим парсер под любой сайт!

Макрос сохранения листа Excel в файл

Данный макрос позволяет упростить процедуру сохранения активного листа в книге Excel в отдельный файл.

Для использования этого макроса на любом листе в книге Excel создайте кнопку, и назначьте ей макрос СохранитьЛистВФайл.

При запуске макроса (нажатии кнопки) будет выведено диалоговое окно выбора имени для сохраняемого файла, после чего текущий лист будет сохранён под заданным именем в выбранной папке.

Сохранение производится в формате XLS (формат Excel 2003)
Если пользователь отказался от ввода имени файла (нажал клавишу ESC или кнопку «Отмена» в диалоговом окне),
то сохранения листа в файл не происходит.

Sub СохранитьЛистВФайл()
    On Error Resume Next
    ' название подпапки, в которую по-умолчанию будет предложено сохранить файл
    Const REPORTS_FOLDER = "Отчёты\"
    ' создаём папку для файла, если её ещё нет
    MkDir ThisWorkbook.Path & "\" & REPORTS_FOLDER
    ' выбираем стартовую папку
    ChDrive Left(ThisWorkbook.Path, 1): ChDir ThisWorkbook.Path & "\" & REPORTS_FOLDER
 
    ' вывод диалогового окна для запроса имени сохраняемого файла
    Filename = Application.GetSaveAsFilename("отчёт.xls", "Отчёты Excel (*.xls),", , _
                                             "Введите имя файла для сохраняемого отчёта", "Сохранить")
    ' если пользователь отказался от выбора имени файла - отменяем сохранение листа в файл
    If VarType(Filename) = vbBoolean Then Exit Sub
 
    ' копируем активный лист (при этом создаётся новая книга)
    Err.Clear: ActiveSheet.Copy: DoEvents
    If Err Then Exit Sub    ' произошла какая-то ошибка при попытке копирования листа

    ' убеждаемся, что активной книгой является копия листа
    If ActiveWorkbook.Worksheets.Count = 1 And ActiveWorkbook.Path = "" Then
        ' сохраняем файл под заданным именем в формате Excel 2003
        ActiveWorkbook.SaveAs Filename, xlWorkbookNormal
 
        ' закрываем сохранённый файл
        ' (удалите следующую строку, если закрывать созданный файл не требуется)
        ActiveWorkbook.Close False
    End If
End Sub

 

PS: Кто-то может сказать, что для сохранения листа в файл в объектной модели Excel есть метод SaveAs, применимый к объекту Worksheet.

Но, как ни странно, выполнение кода ActiveSheet.SaveAs "<имя файла>" приводит к сохранению книги целиком, что равносильно использованию кода ActiveWorkbook.SaveAs "<имя файла>"

Почему этот метод сохранения работает так нелогично - лично мне не понятно (видимо, Microsoft что-то там перемудрил)

Комментарии

Настройки просмотра комментариев

Выберите нужный метод показа комментариев и нажмите "Сохранить установки".

Спасибо за ответ. все дело было в неверном указании количества листов. А переменная ПутьКПапке выбирается пользователем ранее. Правда теперь у меня встал следующий вопрос. Крайне не хочется позволять пользователю менять какие либо значения в исходном файле, для чего собственно и копируется часть листов в отдельный файл. А так как у меня параноя прокачена в 10 я поставил всем листам книги свойство very hidden. Есть ли возможность как-нибудь изменить код, что бы можно было производить операцию копирования листов с этим свойством?

Тимон, в моём коде проверяется, чтобы в копии файла был один лист:

If ActiveWorkbook.Worksheets.Count = 1

А у вас в копии файла - несколько листов

исправьте 1 на 8, - и всё заработает

и ещё, - вы где-то потеряли строку, которая записывает в переменную ПутьКПапке собственно этот самый путь

в итоге, получится так:

Sub СохранитьЛистыВФайл()
    On Error Resume Next
    Filename = "отчёт.xls"
 
    ' копируем активный лист (при этом создаётся новая книга)
    Err.Clear: Worksheets(Array("Техн.тепло", "Вода", "Стоки", "отопление", "Эл .энергия", "Вода хоз.быт.", "Хозбытовые стоки", "воздух")).Copy: DoEvents
    If Err Then Exit Sub        ' произошла какая-то ошибка при попытке копирования листа

    If ActiveWorkbook.Worksheets.Count = 8 And ActiveWorkbook.Path = "" Then
        ' сохраняем файл под заданным именем в формате Excel 2003
        ActiveWorkbook.SaveAs ThisWorkbook.Path & "\" & Filename, xlWorkbookNormal
        ' закрываем сохранённый файл
        ActiveWorkbook.Close False
    End If
End Sub

Написал код по образцу:

Sub СохранитьЛистыВФайл()
Filename = "отчёт.xls"

' копируем активный лист (при этом создаётся новая книга)
Err.Clear: Worksheets(Array("Техн.тепло", "Вода", "Стоки", "отопление", "Эл .энергия", "Вода хоз.быт.", "Хозбытовые стоки", "воздух")).Copy: DoEvents
If Err Then Exit Sub ' произошла какая-то ошибка при попытке копирования листа

' убеждаемся, что активной книгой является копия листа
If ActiveWorkbook.Worksheets.Count = 1 And ActiveWorkbook.Path = "" Then
' сохраняем файл под заданным именем в формате Excel 2003
ActiveWorkbook.SaveAs ПутьКПапке & Filename, xlWorkbookNormal

' закрываем сохранённый файл
' (удалите следующую строку, если закрывать созданный файл не требуется)
ActiveWorkbook.Close False
End If
End Sub

только он работает не так как нужно. копирует выбранные листы в файл, который называет "Книга1" открывает ее и дальше не сохраняет и не закрывает.... подскажите пожалуйста, что мои кривые руки опять собрали в неверном порядке?

Владимир, мой макрос только сохраняет лист в файл.
Ширину столбцов макрос ну никак не может поменять...
Вам надо искать причину в чем-то другом, - возможно, есть где-то в файле другие макросы.

У меня оффис 2010. При сохранении нарушается ширина столбцов. Как исправить???

А имя файла в ячейке хранится вместе с расширением?
если нет, - то программно дописывайте расширение к тексту из ячейки, и проблема исчезнет

Здравствуйте.

У меня имя файла по умолчанию(при открытии диалогового окна) берется из ячейки. Если в ячейки написано слово с точками например: "PHP.FGR.001" то в окне выбора файла не отображается заданное имя файла. А если без точек то все хорошо. Почему так происходит?

Чтобы не удалять все имена и связи с листа, - просто надо не копировать лист целиком,
а создать новый файл с одним листом, и на него вставить массив данных с листа "Store"
(скопировать только значения)

По сохранению файла на рабочем столе:

   ' получаем путь к папке "Рабочий стол"
   ПутьКРабочемуСтолу = CreateObject("WScript.Shell").SpecialFolders("Desktop")
 
   ' сохраняем файл на рабочем столе
   ActiveWorkbook.SaveAs ПутьКРабочемуСтолу & "\Ship Store Arr.xls", xlExcel8

Доброго дня, нужна помощь, что и на что нужно изменить чтобы выбранный лист сохранялся на рабочий стол вне зависимости от точного адреса этого самого рабочего стола, на подобии команды .specialfolders("desktop") и как правильно её написать?
И второе, как убрать все BreakLink не прописывая их все вручную?

Sub StoresArr()
 
    Sheets("Store").Copy
    ActiveSheet.Unprotect
   Dim astrLinks As Variant
 
    ' Define variable as an Excel link type.
    astrLinks = ActiveWorkbook.LinkSources(Type:=xlLinkTypeExcelLinks)
 
    ' Break the first link in the active workbook.
    ActiveWorkbook.BreakLink _
        Name:=astrLinks(1), _
        Type:=xlLinkTypeExcelLinks
    ActiveWorkbook.Names("Arrdep").Delete
    ActiveWorkbook.Names("call").Delete
    ActiveWorkbook.Names("Cap").Delete
    ActiveWorkbook.Names("country").Delete
    ActiveWorkbook.Names("date").Delete
  ' ActiveWorkbook.Names("dep").Delete
    ActiveWorkbook.Names("flag").Delete
    ActiveWorkbook.Names("imo").Delete
   ' ActiveWorkbook.Names("location").Delete
    ActiveWorkbook.Names("mv").Delete
    ActiveWorkbook.Names("nex").Delete
    ActiveWorkbook.Names("Port").Delete
    ActiveWorkbook.Names("PortLoc").Delete
    ActiveWorkbook.SaveAs Filename:= _
        "C:\Documents and Settings\Catania\Desktop\Ship Store Arr.xls", FileFormat:=xlExcel8 _
        , Password:="", WriteResPassword:="", ReadOnlyRecommended:=False, _
        CreateBackup:=False
        ActiveWindow.Close
    Sheets("DATA").Select
End Sub

Прошу не ругать за мою корявую работу, а помочь с решением проблемы, только начинаю осваивать Excel в самостоятельном порядке.
Зарание спасибо

Здравствуйте, Андрей
Попробуйте так:

    Filename$ = ThisWorkbook.Path & "\" & Replace(ThisWorkbook.Name, ".xls", "_" & Range("a1").Value & ".xls")

Добрый день!
Подскажите, пожалуйста, на Вашем примере, если мне нужно сохранить активный лист из книги в ту же папку, где и сама книга, но название ему присвоить по названию самой книги и добавить к нему название из определенной ячейки (например А1)(для Excel 2010)?
Что-то вроде
Filename$ = ThisWorkbook.Path & "\" & "здесь_имя_книги" & "_" & "А1" ".xlsx"

Всё гениальное просто. Спасибо за помощь. И отдельное спасибо за оперативность.

Здравствуйте, Константин
Всё просто:

Filename = format(now, "YYYY-MM-DD-HH-NN") & ".xlsx"

Здравствуйте.
Нужно, чтобы имя файла задавалось автоматически по шаблону год-месяц-число-часы-минуты.xlsx
Пошёл по следующему пути: создал на листе ячейку, форматированную как Дата, и Вашим макросом, взятым из комментариев, присваиваю сохраняемому файлу имя, взятое из этой ячейки. Способ не самый удачный по причине того, что данные в этой ячейке нужно каждый раз обновлять, что не всегда случается (человеческий фактор). Можно ли реализовать задумку иным способом?

Здравствуйте, Сергей.

Вместо

ActiveWorkbook.SaveAs sFilename, xlNormal

напишите

ActiveWorkbook.Save ' сохраняем текущий файл
ActiveWorkbook.SaveCopyAs sFilename ' создаём копию файла

Здравствуйте!

Вы мне в своё время помогли в макросом СОХРАНИТЬ КАК с переходом в нужную папку и заданием шаблона будущего файла.

Вот он:

Sub Сохранить_как_док()
' название подпапки, в которую по-умолчанию будет предложено сохранить файл
Const REPORTS_FOLDER = "E:\Rassil 2004\Документальные ведомости\"
Dim sFilename
' выбираем стартовую папку
ChDrive Left(REPORTS_FOLDER, 1): ChDir REPORTS_FOLDER

' вывод диалогового окна для запроса имени сохраняемого файла
sFilename = Application.GetSaveAsFilename("_2013.xls", "Отчёты Excel (*.xls*),", , _
"Введите имя файла для сохраняемого отчёта", "Сохранить")
' если пользователь отказался от выбора имени файла - отменяем сохранение листа в файл
If VarType(sFilename) = vbBoolean Then Exit Sub

ActiveWorkbook.SaveAs sFilename, xlNormal
End Sub

Спасибо ещё раз большое, но возникла небольшая трудность.
Если исходный файл предварительно не сохранить принудительно, то при применения макроса СОХРАНИТЬ КАК да, создаётся сохранённый новый файл, а оригинал не сохраняется и теряет данные. Да, иелось ввиду, что не сам файл не сохраняется, а не сохраняются именно последние внесённые данные, которые не были сохранены вручную

Прошу подсказать, что необходимо добавить в макрос, что бы при СОХРАНИТЬ КАК и создавался новый файл и сохранялся оригинал?
И возможно ли дополнительно сделать, что бы оригинал при этом не закрывалчя?

Удачи!

Здравствуйте! Помогите пожалуйста.
У меня в Excelе есть анкета,хочу создать кнопку "сохранить" внизу анкеты, и чтобы оно сохраняло только изменения именно в этой анкете. И если ответили не на все вопросы, вышла надпись "Вы не ответили на все вопросы".
Это возможно?
Заранее всем спасибо!

А вы разместите кнопку на другом листе,
или же вообще без кнопки, - назначьте макросу комбинацию "горячих клавиш", - и проблема будет решена.

Спасибо, скачал "Макрос сохранения листа Excel в файл"
А как избавиться от кнопки макроса в копиях? Макросов там нет. а кнопки торчат.

Здравствуйте!

Единственно у меня заработал код после добавления строки вверху:

Dim Filename As Variant

Поясните с чем это связано?

Уже разобрался. Все работает. Спасибо. Вопрос немного не по теме - нужен макрос, который бы при распечатки листа из одной книги заносил некоторые данные в другую книгу, закрытую. Смысл - есть 4 рабочих станции, с которых распечатывают заявления клиентов, нужно составлять реестр распечатанных заявлений на общем сетевом диске. Подскажите, есть ли что-то подобное уже в готовом виде или хотя бы примерно похожее, я бы допилил самостоятельно. Спасибо!

Здравствуйте, Максим.
После создания новой книги путем копирования листа (ActiveSheet.Copy), новая (созданная) книга ВСЕГДА становится активной.
Если вы ничего не меняли в коде, и в ваших файлах нет никаких макросов, которые могут влиять на активацию книг, - то все должно работать.

При работе макроса выясняю, что он сохраняет лист в отдельную книгу, но при открытии новой книги активное окно остается та, книга, из которой копируется лист, соответственно, условие If ActiveWorkbook.Worksheets.Count = 1 не выполняется. Что я делаю не так?

Для этого нужен уже другой макрос, более сложный
Могу сделать под заказ.

Как сохранить в файл только выбранный диапазон, с шапкой, выбранный сортировкой по столбцу.

Здравствуйте! Подскажите пожалуйста команду или сам макрос: я копирую значение ячеек из одной книги в другую, но в другой книге мне нужно к этому значению еще добавлять одну и ту же запись. вобщем как при копировании макросом к скопированному при вставке еще приписывалось бы определенная запись. пример: в первой книге столбик с данными. ставлю курсор на нужную мне запись которую надо скопировать в другую книгу. допустим А1 запись - TP010-0068287. а мне нужно что бы она скопировалась в другую открытую книгу но на конце бы приписывалось -16-01-20. то есть в итоге в другой книге в ячейке А1 была бы запись TP010-0068287-16-01-20. спасибо!

Ой! я только сейчас заметил что услуга платная
напишете на почту стоимость данного вопроса

Анатолий, раз, по вашим словам, в скриптах вы совсем ничего не понимаете, вариантов-то получается немного:
1) обратиться за помощью на форумы по Excel (прикрепив там пример файла)
2) продолжать разбираться самостоятельно
3) оформить заказ у меня на сайте (я сам разберусь, что к чему, и вы получите готовое решение)

я в скриптах мало что понимаю (точней совсем не понимаю) все делаю методом тыка

изменил верх и низ макроса по вашим рекомендациям
теперь происходит вот что
При запуске макроса (нажатии кнопки) выведено диалоговое окно выбора имени для сохраняемого файла, после чего 2 не активных листа будет сохранён под заданным именем в выбранной папки (без формул)
после нажатия сохранить
происходят дальнейшие действия
автоматически еще раз сохраняет файл (имя файла берет из активного листа ячейки "В2"(все правильно) в папку на рабочем столе (новую папку не создает если значение ячейки "С2" активного листа изменилось)

Здравствуйте, Анатолий.
Так попробуйте:

Sub test()
    On Error Resume Next
    folder$ = "C:\Documents and Settings\Admin\Рабочий стол\" & Worksheets(1).Range("C12") & "\"
    MkDir folder$        ' создаем папку, если её ещё нет

    filename = [B2] & ".xls" ' формируем имя файла из текста ячеек

    ' тут много кода, который можно было и не выкладывать...

    ' ОБРАТИТЕ ВНИМАНИЕ: folder$ & filename, а не  filename
    ActiveWorkbook.SaveAs folder$ & filename, xlWorkbookNormal
 
    'закрыть книгу после сохранения
    ActiveWorkbook.Close False ' зачем TRUE? зачем сохранять повторно???
End Sub

методом тыка у меня получилось вот что

On Error Resume Next
Folder$ = "C:\Documents and Settings\Admin\Рабочий стол\" & Worksheets(1).Range("C12") & "\"
MkDir Folder$ ' создаем папку, если её ещё нет

' формируем имя файла из текста ячеек
Filename = [B2] & ".xls"

Dim Ar(), ArAll&(), Sh As Excel.Worksheet, n
Ar = Array(3, 4) 'порядковые номера сохраняемых листов с формулами
ReDim Preserve ArAll(0 To ThisWorkbook.Worksheets.Count - 1)
For Each Sh In ThisWorkbook.Worksheets
ArAll(n) = Sh.Index
n = n + 1
Next
ThisWorkbook.Worksheets(ArAll).Copy
ActiveWorkbook.Sheets(Ar(0)).Activate
Application.Volatile
Application.Calculate
Application.ScreenUpdating = False
For Each n In Ar
With ActiveWorkbook.Worksheets(n).UsedRange.Cells
.Value = .Value
End With
Next
Erase ArAll: n = 0
ReDim Preserve ArAll(0 To ThisWorkbook.Worksheets.Count - 1 - (UBound(Ar) + 1))
For Each Sh In ActiveWorkbook.Worksheets
If IsError(Application.Match(Sh.Index, Ar, 0)) Then
ArAll(n) = Sh.Index
n = n + 1
End If
Next
ActiveWorkbook.SaveAs Filename, xlWorkbookNormal

'закрыть книгу после сохранения
ActiveWorkbook.Close True
On Error Resume Next
Kill tempfile
End Sub

теперь имя файла сохраняется значению ячейки активного листа, а папку не получается сделать так чтобы имя вставало из активного листа С2

в этом скрипте много лишнего из за этого немного подвисает но когда больше ничего нет приходится работать тем что есть

доброго времени суток.
подскажите что нужно убрать, и что нужно дописать или заменить, чтобы имя папки (сохранялось) = значение ячейки (С2) активного листа там где кнопка , а имя файла(сохранялось) = значение ячейки (В2) активного листа там где кнопка
если такой файл существует то перезаписать

On Error Resume Next
' название подпапки, в которую по-умолчанию будет предложено сохранить файл
Const REPORTS_FOLDER = "Отчёты\"
' создаём папку для файла, если её ещё нет
MkDir ThisWorkbook.Path & "\" & REPORTS_FOLDER
' выбираем стартовую папку
ChDrive Left(ThisWorkbook.Path, 1): ChDir ThisWorkbook.Path & "\" & REPORTS_FOLDER

Dim Ar(), ArAll&(), Sh As Excel.Worksheet, n
Ar = Array(3, 4) 'порядковые номера сохраняемых листов с формулами
ReDim Preserve ArAll(0 To ThisWorkbook.Worksheets.Count - 1)
For Each Sh In ThisWorkbook.Worksheets
ArAll(n) = Sh.Index
n = n + 1
Next
ThisWorkbook.Worksheets(ArAll).Copy
ActiveWorkbook.Sheets(Ar(0)).Activate
Application.Volatile
Application.Calculate
Application.ScreenUpdating = False
For Each n In Ar
With ActiveWorkbook.Worksheets(n).UsedRange.Cells
.Value = .Value
End With
Next
Erase ArAll: n = 0
ReDim Preserve ArAll(0 To ThisWorkbook.Worksheets.Count - 1 - (UBound(Ar) + 1))
For Each Sh In ActiveWorkbook.Worksheets
If IsError(Application.Match(Sh.Index, Ar, 0)) Then
ArAll(n) = Sh.Index
n = n + 1
End If
Next
Application.DisplayAlerts = False
ActiveWorkbook.Worksheets(ArAll).Delete
Application.DisplayAlerts = True
Application.ScreenUpdating = True
Application.Dialogs(xlDialogSaveAs).Show
'закрыть книгу после сохранения
ActiveWorkbook.Close True
On Error Resume Next
Kill tempfile
End Sub

1.) для офиса 2007 (без сохранения макросов )формат xlsx, для 2003?, как сохранять ни весь лист а определенную область?
2.) как с помощью макроса открыть word и скопировать туда данные с excel?

А какое отношение ваш вопрос имеет к теме статьи?

1. используйте ActiveWorkbook.SaveAs Filename, xlOpenXMLWorkbook
Это сохранит книгу в формате XLSX - без поддержки макросов (соответственно, они все автоматически удалятся после закрытия файла)
Предварительно замените все формулы значениями, в цикле пройдясь по листам,

    For Each sh In ActiveWorkbook.Worksheets
       sh.usedrange.value=sh.usedrange.value
    Next sh

2. Скопируйте весь лист Excel, вставьте в Word, и в контекстном меню вставки выберите опцию «вставить как изображение»

Здравствуйте подскажите два макроса:
1. как сохранить всю книгу (или лист) без макросов и формул ?
2. как сохранить файл из excel в word(что бы в ворде отоброжалось как картинка)?

Спасибо, уже сам справился...

Добрый день! Помогите, пожалуйста, сохранить файл с именем из ячейки C2 в новую папку с именем, взятым из E3 . Заранее благодарен!

Александр, не поленитесь, - прочитайте все комментарии к статье.
В них вы найдёте ответы на свои вопросы.

Доброго времени суток! Как сохранить не активный лист, а несколько листов сразу (например 4) в одну книгу с задание имени файла по определенной ячейке?
Заранее спасибо!

Все нашел сам :)
вместо saveas надо использовать ExportAsFixedFormat

про имя из ячеек нашел сам... а как сохранять в pdf пока не разобрался.... помогите плиз.

а может этот макрос сохранить в формате PDF с именем заданным из ячеек ?

Спасибо за замечание, исправил.

Спасибо за код.Все работает ка надо.
При сохранении файла не добавляется расширение к файлу из за банальной опечатки :) :
"Filename = Application.GetSaveAsFilename("отчёт.xls", "Отчёты Excel (*.xls*),....)"
Поправьте на : "(*.xls)", просто лишний знак "*"

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

Мало того, я думал сохранит Excel только с данными, которые задал фильтрами

Прочитайте внимательно название статьи: "Сохранение ЛИСТА в файл"
Вот лист целиком и сохраняется.

Насчёт того, как включить запись макросов, - в интернете про это много написано,
в том числе и видеоинструкции есть (разобраться несложно)
Если разбираться некогда (или лень) - можете оформить заказ, я сам все сделаю (не бесплатно)

И навожу и отправляю... Он сохраняет как заданное имя и все... если только не прописывать имя.xlsx Мало того, я думал сохранит Excel только с данными, которые задал фильтрами, а он весь файл сохранил... Про удаление не знаю где включить запись( и как...

Сохраняет без расширения? Не верю...
Отправьте созданный файл сами себе по почте, или щелкните правой кнопкой на нём, и посмотрите свойства.
И расширение файла чудесным образом появится из ниоткуда)

По удалению столбцов - включите запись макросов, выполните необходимые действия, - получите нужный код.
Потом вставьте полученный код в макрос из статьи, перед строкой

ActiveWorkbook.SaveAs Filename, xlOpenXMLWorkbook

галочку снял чтобы показывало расширение и при сохранении внизу показывает xlsx, но сохраняет все равно как файл без раширения... Удалить лишние столбцы вы имеете ввиду вручную? если нет, можно примерчик? очень благодарен вам за ответы.

Что значит «без формата»? То, что вы не видите расширение XLSX у созданного файла?
Так, может, у вас отображение расширений файлов в Windows отключено?

Всё можно задать, - например, удалив лишние столбцы после создания копии листа.

Отправить комментарий

Содержание этого поля является приватным и не предназначено к показу.
CAPTCHA
Подтвердите, пожалуйста, что вы - человек:
                     _____  __     __      _   _____ 
_ __ ___ ___ | ____| \ \ / / __| | | ___|
| '_ ` _ \ / _ \ | _| \ \ / / / _` | | |_
| | | | | | | __/ | |___ \ V / | (_| | | _|
|_| |_| |_| \___| |_____| \_/ \__,_| |_|
Введите код, изображенный в стиле ASCII-арт.

Не получается применить макрос? Не удаётся изменить код под свои нужды?

Оформите заказ у нас на сайте, не забыв прикрепить примеры файлов, и описать, что и как должно работать.