导出Excel,VBA时停止隐藏的工作表

时间:2016-09-17 09:17:30

标签: excel-vba vba excel

我有一个宏代码,可以将工作簿中的所有工作表复制到新工作簿中。这很有效但问题是它也复制了隐藏的工作表。有人可以帮我修改代码,使其只复制可见的工作表。

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

1 个答案:

答案 0 :(得分:1)

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