（VBA）特定のシートのみを名前を付けて保存

質問

Excel2003です。
数シートあるうちの特定のシートのみを別のbookとして「名前を付けて保存」する下記のコードを書きました。一応うまく動くのですが、実はこの特定のシートには行の非表示部分があります。しかし、下記のコードではもちろん非表示部分も開かれた状態で保存がされますよね。
この非表示の状態で保存するにはどのようにすればよいのでしょうか？
【以下現在のコードです】
------------------------------------------------
Sub 名前を付けて保存()

'報告書を"名前を付けて保存"

Sheets("報告書").Select

Dim 既定ファイル名 As String
Dim 保存ファイル名 As Variant
既定ファイル名 = "報告書"
保存ファイル名 = Application.GetSaveAsFilename(既定ファイル名, "Excel ブック(*.xls),*.xls")
If 保存ファイル名 = False Then
MsgBox "保存は中止されました。"
Else
With ThisWorkbook.ActiveSheet
Workbooks.Add
.Cells.Copy ActiveSheet.Range("A1")
ActiveWorkbook.SaveAs 保存ファイル名, xlNormal
ActiveWorkbook.Close False
End With
Sheets("報告書").Select
Range("A1").Select
MsgBox "報告書を作成しました。"
End If
End Sub
----------------------------------------------------

回答No.3

keirika · ベストアンサー

Sub 名前を付けて保存()

'報告書を"名前を付けて保存"

Sheets("報告書").Select

Dim 既定ファイル名 As String
Dim 保存ファイル名 As Variant
既定ファイル名 = "報告書"
保存ファイル名 = Application.GetSaveAsFilename(既定ファイル名, "Excel ブック(*.xls),*.xls")
If 保存ファイル名 = False Then
MsgBox "保存は中止されました。"
Else
With ThisWorkbook.ActiveSheet
Workbooks.Add
.Copy After:=ActiveWorkbook.Sheets(1)
Application.DisplayAlerts = False
ActiveWorkbook.Sheets(1).Delete
Application.DisplayAlerts = True
ActiveWorkbook.SaveAs 保存ファイル名, xlNormal
ActiveWorkbook.Close False
End With
Sheets("報告書").Select
Range("A1").Select
MsgBox "報告書を作成しました。"
End If
End Sub

でどうでしょう。

お礼

すみません。
Excel2003とは書いたのですが、実はExcel2007で作成をして保存をする時にExcel97-2003で互換性のある形で保存しております。これがいけなかったのでしょうか・・・
本日改めて本当のExcel2003のソフトで保存したところ、コードの修正をすることなく非表示の件もうまくいきました。
もちろん、ご指摘いただいたコードでもうまくいきました。
Exscel2007は最近使用し始めたばかりで、よくわかっていません。

補足

すみません。
「お礼」の欄で書かせた内容を訂正いたします。
ちょっと私混乱しておりました。非表示の件は、修正なしでは解決していませんでした。
ご指摘のコードで解決です！！
ありがとうございました。

回答No.4

Wendy02

こんにちは。

提案1

他の不要のシートが必要ない場合。

　With ThisWorkbook.ActiveSheet
　　　　　　.Copy
　　　　　　ActiveWorkbook.SaveAs 保存ファイル名, xlNormal
　　　　　　ActiveWorkbook.Close False
End With

提案2

PasteSpecial を使う方法。

With ThisWorkbook.ActiveSheet
　　　　　　Workbooks.Add
　　　　　　.Cells.Copy
　　　　　　ActiveSheet.Cells.PasteSpecial
　　　　　　ActiveSheet.Cells(1, 1).Select
　　　　　　ActiveWorkbook.SaveAs 保存ファイル名, xlNormal
　　　　　　ActiveWorkbook.Close False
End With
　　Application.CutCopyMode = False　'必要に応じて

お礼

ありがとうございます。
とても参考になりました。

回答No.2

nayuta_lot

＃１です。　補足します。
そちらのコードをそのまま実行すると別のブックを新規で作成して
おり（Workbooks.Add）、そのブックのSheet1がアクティブシートと
いう状態で下記のコマンドを実行しています。

.Cells.Copy ActiveSheet.Range("A1")
ActiveWorkbook.SaveAs 保存ファイル名, xlNormal
ActiveWorkbook.Close False

ですから空のファイルができているのではないかと思いますが・・
マクロ実行時にステップで行うと動きがわかりますよ。　Ｆ８で
次の行を順次実行していきます。
ご確認ください。

お礼

ありがとうございます。
現在の私のコードで非表示以外は問題なく新規のファイルで保存されます（空の状態ではありません）

回答No.1

nayuta_lot

こんにちは
下記のような感じでどうですか？

Sub 名前を付けて保存()

'報告書を"名前を付けて保存"

Sheets("報告書").Select

Dim 既定ファイル名 As String
Dim 保存ファイル名 As Variant

既定ファイル名 = "報告書"
保存ファイル名 = Application.GetSaveAsFilename(既定ファイル名, "Excel ブック(*.xls),*.xls")

If 保存ファイル名 = False Then
MsgBox "保存は中止されました。"
Else

'With ThisWorkbook.ActiveSheet コメントアウト
'Workbooks.Add コメントアウト
'.Cells.Copy ActiveSheet.Range("A1") コメントアウト

Sheets("報告書").Copy '追加　シートを別ブックにコピー
Range("A1").Select '追加　A1を選択

'ActiveWorkbook.SaveAs 保存ファイル名, xlNormal コメントアウト
ActiveWorkbook.SaveAs Filename:=保存ファイル名 _
, FileFormat:=xlNormal, Password:="", WriteResPassword:="", _
ReadOnlyRecommended:=False, CreateBackup:=False '文法を修正（マクロの記録で簡単にチェックできます。）

ActiveWorkbook.Close False
'End With コメントアウト

Sheets("報告書").Select
Range("A1").Select
MsgBox "報告書を作成しました。"

End If

End Sub

訂正箇所

　ブックを新しいファイルにコピー
　Ｓａｖｅ時の文法を修正

以上、ご参考まで