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

Добрый день. Прошу помощи в примитивной наверное для вас ошибки... Сам дуб дубом пока что в VBA, надеюсь со временем обучусь.
Проблема в том, что есть чекбоксы в виде галочек, для них есть кнопки (выделить все и снять выделение),есть формулы в ячейках. И чтобы случайно их не удалили, поставил защиту. Часть ячеек без защиты (нужны для ввода данных). Так вот проблема в том, что после сохранения перестают отробатывать макросы для этих самых голочек, при нажатии кнопок под них. ошибка в строкt:
Range("B5:G5, K5:O5").Interior.Color = RGB(196, 215, 155)

такой написан код: (для голочки с выделением по цвету и двух кнопок)
Private Sub CheckBox1_Click()
If CheckBox1 = True Then
Range("B5:G5, K5:O5").Interior.Color = RGB(196, 215, 155)
Else
Range("B5:G5, K5:O5").Interior.Color = RGB(196, 215, 155)
End If
End Sub
Private Sub CommandButton1_Click()
CheckBox1 = 1
End Sub
Private Sub CommandButton2_Click()
CheckBox1 = 0
End Sub

Такой код написан для защиты листа
Sub Protect_for_User_Non_for_VBA()
Sheets(Лист1).Protect Password:="", UserInterfaceOnly:=True
End Sub

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

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

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" то в окне выбора файла не отображается заданное имя файла. А если без точек то все хорошо. Почему так происходит?

Доброго дня, нужна помощь, что и на что нужно изменить чтобы выбранный лист сохранялся на рабочий стол вне зависимости от точного адреса этого самого рабочего стола, на подобии команды .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 в самостоятельном порядке.
Зарание спасибо

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

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

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

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

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

Вот он:

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 рабочих станции, с которых распечатывают заявления клиентов, нужно составлять реестр распечатанных заявлений на общем сетевом диске. Подскажите, есть ли что-то подобное уже в готовом виде или хотя бы примерно похожее, я бы допилил самостоятельно. Спасибо!

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

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

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

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

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

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

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

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. как сохранить всю книгу (или лист) без макросов и формул ?
2. как сохранить файл из excel в word(что бы в ворде отоброжалось как картинка)?

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

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

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

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

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

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

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

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

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