CODEWITHSUNDEEP
excelvba
Danny
Danny

Reputation: 89

Stop hidden sheets in exporting Excel, VBA

I have a Macro code that copy's all sheets in my workbook to a new workbook. This works well but the problem is that it copies hidden sheets as well. Can someone help me modify the code so that it copies only the visible sheets.

Sub export()

Dim Sht             As Worksheet
Dim DestSht         As Worksheet
Dim DesktopPath     As String
Dim NewWbName       As String
Dim wb              As Workbook
Dim i               As Long

Set wb = Workbooks.Add

DesktopPath = "C:\Users\" & Environ("USERNAME") & "\Desktop\"

NewWbName = "report " & Format(Now, "yyyy_mm_dd _hh_mm_ss") & ".xlsx"
i = 1

For Each Sht In ThisWorkbook.Sheets

If i <= wb.Sheets.Count Then
    Set DestSht = wb.Sheets(i)
Else
    Set DestSht = wb.Sheets.Add
End If

Sht.Cells.Copy
With DestSht
    .Cells.PasteSpecial (xlPasteValues)
    .Cells.PasteSpecial (xlPasteFormats)
    .Name = Sht.Name
End With

i = i + 1
Next Sht

Application.DisplayAlerts = False

wb.SaveAs Filename:=DesktopPath & NewWbName, FileFormat:=51
wb.Close
MsgBox "You Can Find The Exported File In Your Desktop.", vbOKOnly +   vbInformation, "Export Sucessful!"

Application.DisplayAlerts = True

End Sub

Upvotes: 0

Views: 84

Answers (1)

Socii
Socii

Reputation: 545

Sub export()

Dim Sht             As Worksheet
Dim DestSht         As Worksheet
Dim DesktopPath     As String
Dim NewWbName       As String
Dim wb              As Workbook
Dim i               As Long

Set wb = Workbooks.Add

DesktopPath = "C:\Users\" & Environ("USERNAME") & "\Desktop\"

NewWbName = "report " & Format(Now, "yyyy_mm_dd _hh_mm_ss") & ".xlsx"

i = 1

    For Each Sht In ThisWorkbook.Sheets

        If Sht.Visible = xlSheetVisible Then

            If i <= wb.Sheets.Count Then
                Set DestSht = wb.Sheets(i)
            Else
                Set DestSht = wb.Sheets.Add
                DestSht.Move After:=Sheets(wb.Sheets.Count)
            End If

            Sht.Cells.Copy
            With DestSht
                .Cells.PasteSpecial (xlPasteValues)
                .Cells.PasteSpecial (xlPasteFormats)
                .Name = Sht.Name
            End With

            i = i + 1

        End If

    Next Sht

Application.DisplayAlerts = False

wb.SaveAs Filename:=DesktopPath & NewWbName, FileFormat:=51
wb.Close
MsgBox "You Can Find The Exported File In Your Desktop.", vbOKOnly +   vbInformation, "Export Sucessful!"

Application.DisplayAlerts = True

End Sub

Upvotes: 1

Related Questions