Copying only the visible cells from visible worksheets into a new workbook, excel 2007 VBA

geekypenguin Published at Dev

geekypenguin

I have a master spreadsheet Master Spreadsheet.xlsm and I want to use it to create another spreadsheet defined by OutputFN.
This second spreadsheet needs to be a copy of the first but only containing the visible cells from visible worksheets in the first.

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

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

Collected from the Internet

Please contact [email protected] to delete if infringement.