Excel 2003 VBA: переместить лист в новую книгу, на которую ссылается переменная - PullRequest
Новая
       18

Excel 2003 VBA: переместить лист в новую книгу, на которую ссылается переменная

2 голосов
/ 26 июля 2010

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

Вот как бы я хотел это сделать: 

Sub Split()
    ThisWorkbook.Sheets("Data").PivotTables("Data").ShowPages PageField:="Codename"
    Dim newWb As Workbook

    For Each s In ThisWorkbook.Sheets
        If s.Name <> "Data" Then
            Set newWb = s.Move #This is the line I'm trying to work out
            newWb.SaveAs Filename:="C:\Export\" + s.Name + ".xls"
            newWb.Close
        End If
    Next s

End Sub

К сожалению, это сталкивается с множеством проблем, связанных с отсутствием создания объектов и тому подобного (понятно).Какой самый разумный способ сделать это?

Ответы [ 2 ]

6 голосов
/ 26 июля 2010 
Sub Split()
ThisWorkbook.Sheets("Data").PivotTables("Data").ShowPages PageField:="Codename"
Dim newWb As Workbook   

For Each s In ThisWorkbook.Sheets
    If s.Name <> "Data" Then
        ''Added by Soldieraman
        Dim sheetName As String
        sheetName = s.Name

        Set newWb = Workbooks.Add
        s.Move before:=newWb.Sheets(1)
        Application.DisplayAlerts = False
        newWb.Sheets(Array("Sheet1", "Sheet2", "Sheet3")).Delete
        Application.DisplayAlerts = True

        ''Edited by soldieraman
        newWb.SaveAs Filename:="C:\Export\Test" & sheetName & ".xls"
        newWb.Close
    End If
Next s
End Sub
2 голосов
/ 10 мая 2013

Хотя это старо, и принятый ответ soldieraman очень хорош, просто хотел добавить одну вещь.Методы Excel VBA Sheets.Copy и Sheets.Move имеют очень приятную особенность.Для позиционирования перемещенного / скопированного листа они принимают любой из двух необязательных аргументов «До» или «После».Документация Excel отмечает, что: 

 If you don't specify either Before or After, Microsoft Excel
 creates a new workbook that contains the moved [copied] sheet.

Итак, это почти удивительно, но вы можете просто сказать: 

 Sheets(sheetname).Move

в принятом ответе вместо: 

 Set newWb = Workbooks.Add
 s.Move before:=newWb.Sheets(1)
 Application.DisplayAlerts = False
 newWb.Sheets(Array("Sheet1", "Sheet2", "Sheet3")).Delete
 Application.DisplayAlerts = True

Остальная часть кода soldieraman будет хорошо работать с этим упрощением.

...