2016-09-17 16 views
0

ブックにコピーしたすべてのシートを新しいブックにコピーするマクロコードがあります。これはうまくいくが、隠れたシートもコピーするという問題がある。可視シートだけをコピーするようにコードを修正する手助けをすることができますか?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

あなたにのみ表示シートをコピーするワークシートオブジェクトの 'Visible'プロパティを使用することができます。 'Sht.Visible = xlSheetVisible'の場合... – Socii

+0

ありがとうございます。それは目に見えるシートだけをコピーする仕事でしたが、最初に空白のシートが追加されました。 – Danny

+1

更新されたコードが表示されていないと、わかりにくいですが、 'i = i + 1'コードが'If​​ Sht.Visible = xlSheetVisible Then'ステートメント。私はOKを動作させる必要があります更新されたコードで答えを追加しました。また、追加されたシートを新しいブックの最後に移動する 'Sheet.Move'ステートメントを追加しました。詳細については、[https://support.microsoft.com/en-gb/kb/107622]を参照してください。 – Socii

答えて

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 
関連する問題