2016-09-17 16 views
0

Ich habe einen Makro-Code, der alle Blätter in meiner Arbeitsmappe zu einer neuen Arbeitsmappe kopiert. Das funktioniert gut, aber das Problem ist, dass es auch verdeckte Blätter kopiert. Kann jemand mir helfen, den Code zu ändern, damit er nur die sichtbaren Blätter kopiert.Versteckte Blätter beim Exportieren von Excel, VBA

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 
+0

können Sie verwenden, um die 'Visible' Eigenschaft des Objekts Arbeitsblatt nur die sichtbaren Blätter zu kopieren. Wenn 'Sht.Visible = xlSheetVisible' Dann ... – Socii

+0

Danke Kumpel. Das hat den Job gemacht, es kopiert nur die sichtbaren Blätter, aber es fügt ein leeres Blatt am Anfang hinzu – Danny

+1

Ohne Ihren aktualisierten Code zu sehen, ist es schwer zu sagen, aber ich schätze, Sie haben den 'i = i + 1' Code außerhalb des 'Wenn Sht.Visible = xlSheetVisible Then'-Anweisung. Ich habe eine Antwort mit aktualisiertem Code hinzugefügt, die OK funktionieren sollte. Ich habe auch eine 'Sheet.Move'-Anweisung hinzugefügt, die jedes hinzugefügte Blatt an das Ende der neuen Arbeitsmappe verschiebt. Weitere Informationen finden Sie unter [https://support.microsoft.com/en-gb/kb/107622]. – Socii

Antwort

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 
Verwandte Themen