сохранить некоторые листы в отдельные файлы

ОльгаБ

Гость

21.07.2011 11:30:06

Добрый день. Прошу помощи в решении следующей задачи. Есть файл, состоящий из нескольких листов. Требуется написать макрос для сохранения некоторых листов в отдельные файлы. На форуме нашла макрос по сохранению всех листов в отдельные файлы, а вот как быть с сохранением определенных листов в отдельные файлы не знаю. В приложенном файле необходимо сохранять в отдельные файлы только листы "Купля" и "Продажа" Имя файла должно браться по названию листа, лист должен сохраняться без формул - только значения. Спасибо.

Прикрепленные файлы

post_243420.xls (43.5 КБ)

ran Пользователь Сообщений: 7207 Регистрация: 21.12.2012	#2 21.07.2011 11:38:35 А почему найденный макрос постеснялись приложить?

www Пользователь Сообщений: 107 Регистрация: 01.01.1970	#3 21.07.2011 12:19:05 поставь Asap-Utilites :там можно выбрать какие стр.сохранять...(+много других прибамбасов) O Tempora, O Mores!!!

ОльгаБ

Гость

21.07.2011 12:41:21

{quote}{login=RAN}{date=21.07.2011 11:38}{thema=}{post}А почему найденный макрос постеснялись приложить?{/post}{/quote}

Sub test()
Dim wbNew As Workbook
Dim sh As Worksheet

For Each sh In ThisWorkbook.Sheets
Set wbNew = Workbooks.Add
sh.Copy Before:=wbNew.Sheets(1)
Application.DisplayAlerts = False
While wbNew.Sheets.Count <> 1
wbNew.Sheets(wbNew.Sheets.Count).Delete
Wend
Application.DisplayAlerts = True
wbNew.SaveAs (ThisWorkbook.Path & "\" & sh.Name)
Cells.Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("A1").Select
Application.CutCopyMode = False
ActiveWorkbook.Save
wbNew.Close False
Next sh
End Sub

ОльгаБ Гость	#5 21.07.2011 12:51:36 {quote}{login=www}{date=21.07.2011 12:19}{thema=}{post}поставь Asap-Utilites :там можно выбрать какие стр.сохранять...(+много других прибамбасов){/post}{/quote} Никак не получится - установка доп программ запрещена Стандартом о безопасности.

sva

Пользователь

Сообщений: 1027 Регистрация: 23.12.2012

21.07.2011 13:11:18

Sub cc()
Dim sh As Worksheet, wb As Workbook
For Each sh In ThisWorkbook.Worksheets
If sh.Name = "Купля" Or sh.Name = "Продажа" Then
Set wb = Workbooks.Add
sh.Copy Before:=wb.Sheets(1)
Application.DisplayAlerts = False
While wb.Sheets.Count <> 1
wb.Sheets(wb.Sheets.Count).Delete
Wend
Application.DisplayAlerts = True
wb.SaveAs (ThisWorkbook.Path & "\" & sh.Name)
wb.Close
End If
Next
End Sub

ОльгаБ Гость	#7 21.07.2011 13:33:07 Спасибо огромное за помощь!

Казанский Пользователь Сообщений: 8839 Регистрация: 11.01.2013	#8 21.07.2011 15:59:53 На будущее - вместо этого: Set wb = Workbooks.Add sh.Copy Before:=wb.Sheets(1) Application.DisplayAlerts = False While wb.Sheets.Count <> 1 wb.Sheets(wb.Sheets.Count).Delete Wend Application.DisplayAlerts = True wb.SaveAs (ThisWorkbook.Path & "\" & sh.Name) wb.Close просто sh.Copy ActiveWorkbook.Close True, ThisWorkbook.Path & "\" & sh.Name

Читают тему