仅将可见工作表中的可见单元格复制到新工作簿中，excel 2007 VBA
声明：本页面是StackOverFlow热门问题的中英对照翻译，遵循CC BY-SA 4.0协议，如果您需要使用它，必须同样遵循CC BY-SA许可，注明原文地址和作者信息，同时你必须将它归于原作者（不是我）：StackOverFlow
原文地址: http://stackoverflow.com/questions/23133645/
Warning: these are provided under cc-by-sa 4.0 license. You are free to use/share it, But you must attribute it to the original authors (not me):
StackOverFlow
Copying only the visible cells from visible worksheets into a new workbook, excel 2007 VBA
提问by geekypenguin
- I have a master spreadsheet
Master Spreadsheet.xlsmand I want to use it to create another spreadsheet defined byOutputFN. - This second spreadsheet needs to be a copy of the first but only containing the visible cells from visible worksheets in the first.
- 我有一个主电子表格
Master Spreadsheet.xlsm，我想用它来创建另一个由OutputFN. - 第二个电子表格需要是第一个电子表格的副本，但仅包含第一个电子表格中可见工作表中的可见单元格。
I have found code to copy just the visible sheets and other code to copy just the visible cells but not the two together. Any help would be much appreciated.
我找到了只复制可见表的代码，而其他代码则只复制可见单元格而不是将两者复制在一起。任何帮助将非常感激。
This is what I've got so far:
这是我到目前为止所得到的：
Private Sub saveone()
Dim OutputFN As String
Dim OutputWB As Workbook
Dim SourceWB As Workbook
Dim i As Integer
i = 1
Set SourceWB = Application.ActiveWorkbook
OutputFN = ThisWorkbook.Worksheets("Setup Page").Range("B12").Value
Set OutputWB = Workbooks.Add
'Selects active (not hidden cells) from visible sheets and copies
For Each Sheet In ThisWorkbook.Sheets
If Sheet.Visible = True Then
ThisWorkbook.ActiveSheet.Cells. _
SpecialCells(xlCellTypeVisible).Copy
'Pastes into new workbook
Worksheets(i).Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteValues
Selection.PasteSpecial Paste:=xlPasteFormats
'Saves new file as output filename in the directory created earlier
ActiveWorkbook.SaveAs (OutputFN)
i = i + 1
End If
Next
End Sub
采纳答案by brettdj
Something like this
像这样的东西
I've tidied up the variables and tweaked the logic a little as well
我整理了变量并稍微调整了逻辑
Private Sub saveone()
Dim OutputFN As String
Dim OutputWB As Workbook
Dim SourceWB As Workbook
Dim ws As Worksheet
Dim ws2 As Worksheet
Set SourceWB = ThisWorkbook
OutputFN = SourceWB.Worksheets("Setup Page").Range("B12").Value
Set OutputWB = Workbooks.Add(1)
Application.ScreenUpdating = False
For Each ws In SourceWB.Sheets
If ws.Visible Then
Set ws2 = OutputWB.Sheets.Add(After:=OutputWB.Sheets(OutputWB.Sheets.Count))
ws.Cells.SpecialCells(xlCellTypeVisible).Copy
ws2.[a1].PasteSpecial xlPasteValues
ws2.[a1].PasteSpecial xlPasteFormats
End If
Next
Application.ScreenUpdating = True
ActiveWorkbook.SaveAs (OutputFN)
End Sub
