[[20181002162851]]　『VBAで特定のシートだけを別ファイルで保存する方磨x（あかり）　ページの最後に飛ぶ

『VBAで特定のシートだけを別ファイルで保存する方法』（あかり）

VBAで特定のシートだけを別ファイルで保存する方法を教えていただませんか。。。、

・別ファイルのデータは関数ではなく値貼り付けで行いたい。
・保存の際、名前を変更したい。

なお、VBA初心者のため、コードを教えてもらえるととても助かります＞＜

＜使用 Excel：Excel2007、使用 OS：Windows7 ＞

特定のシートが複数ある場合も教えてもらえるととても助かります！！！
（あかり） 2018/10/02(火) 16:31

Q1.特定のシートの選び方は？
Q2.保存するファイルのパスの決め方は？
とりあえず定数で。

 Sub 特定のシートだけを別ファイルで保存する()

    Dim sheetNames As Variant
    Dim shn As Variant
    Dim WB As Workbook

    '特定のシート
    sheetNames = Array("Sheet2", "Sheet3")

    '新規ブックの準備
    Set WB = Workbooks.Add

    For Each shn In sheetNames
        '新規ブックにコピー
        ThisWorkbook.Worksheets(shn).Copy After:=WB.Worksheets(WB.Worksheets.Count)
        '関数を値に変換
        WB.Worksheets(shn).UsedRange.Value = WB.Worksheets(shn).UsedRange.Value
    Next

    Application.DisplayAlerts = False
    WB.Worksheets(1).Delete
    Application.DisplayAlerts = True

    '同じフォルダにnewfile.xlsxで保存
    WB.SaveAs ThisWorkbook.Path & "\newfile.xlsx", XlFileFormat.xlOpenXMLWorkbook
    WB.Close False

End Sub
（名無し） 2018/10/02(火) 16:53

名無しさん

返信ありがとうございます！

Q1.特定のシートの選び方は？
⇒ データをまとめたサマリーシートになります。

   シート名の固定も可能です。

Q2.保存するファイルのパスの決め方は？
⇒ ローカルに保存したいです。

（あかり） 2018/10/02(火) 17:15

では上記のコードのままで良さそうですね。

⇒ データをまとめたサマリーシートになります。
　　シート名はこの部分を追加・編集・削除して下さい。例えば、Sheet4を追加するなら

    sheetNames = Array("Sheet2", "Sheet3", "Sheet4")

⇒ ローカルに保存したいです。
　　保存パスとファイル名の決め方が知りたかったのですが・・・
　　固定で構わないのであれば、この部分を適当になおしてください。

    WB.SaveAs ThisWorkbook.Path & "\newfile.xlsx", XlFileFormat.xlOpenXMLWorkbook

（名無し） 2018/10/02(火) 17:34

名無しさん

ありがとうございます！！！
試してみます！
（あかり） 2018/10/02(火) 18:05

なんか似たような話をMougで見たような。
http://www.moug.net/faq/viewtopic.php?t=77511
↑がヒントになるかも

（もこな２） 2018/10/02(火) 20:39

名無しさん

保存できました！！！！
また、ファイル名に関しては都度設定したいのですが、
その場合はどうなりますでしょうか？？？

もこなさん

ありがとうございます！
参考に確認してみます！
（あかり） 2018/10/03(水) 16:28

＞　ファイル名に関しては都度設定したい

    WB.SaveAs ThisWorkbook.Path & "\newfile.xlsx", XlFileFormat.xlOpenXMLWorkbook
を
    Dim fn As String
    fn = InputBox("ファイル名を入力")
    If fn = "" Then
        MsgBox "キャンセルされました。"
    Else
        WB.SaveAs ThisWorkbook.Path & "\" & fn & ".xlsx", XlFileFormat.xlOpenXMLWorkbook
    End If
という感じで如何でしょう。

（名無し） 2018/10/03(水) 17:41

名無しさん

    WB.SaveAs ThisWorkbook.Path & "\newfile.xlsx", XlFileFormat.xlOpenXMLWorkbook
    WB.Close False

上記部分と置き換える感じですかね？？

また、新しいファイルを作成した時に、マクロのボタン(フォームコントロール)を
シートから消すことってできますか？？？

いろいろ相談してすいません＞＜
（あかり） 2018/10/03(水) 18:47

＞ WB.SaveAs ThisWorkbook.Path & "\newfile.xlsx", XlFileFormat.xlOpenXMLWorkbook
＞ WB.Close False
＞上記部分と置き換える感じですかね？？
WB.Close Falseは保存したブックを閉じる処理なので、開いたまま終わりたいなら消しても良いですよ。

＞マクロのボタン(フォームコントロール)をシートから消すことってできますか？？？
新しく保存したブックにボタンを残したくないってことですよね。
それを反映するとこうなります。

 Sub 特定のシートだけを別ファイルで保存する()
    Dim sheetNames As Variant
    Dim shn As Variant
    Dim WB As Workbook
    Dim callShn As String
    Dim callShp As String

    'マクロ呼び出し元情報の保持
    callShn = ActiveSheet.Name
    callShp = Application.Caller

    '特定のシート
    sheetNames = Array("Sheet2", "Sheet3")

    '新規ブックの準備
    Set WB = Workbooks.Add

    'シートを複写
    For Each shn In sheetNames
        '新規ブックにコピー
        ThisWorkbook.Worksheets(shn).Copy After:=WB.Worksheets(WB.Worksheets.Count)
        '関数を値に変換
        WB.Worksheets(shn).UsedRange.Value = WB.Worksheets(shn).UsedRange.Value
    Next
    Application.DisplayAlerts = False
    WB.Worksheets(1).Delete
    Application.DisplayAlerts = True

    '呼び出し元シェイプの削除
    On Error Resume Next
    WB.Worksheets(callShn).Shapes(callShp).Delete
    On Error GoTo 0

    '同じフォルダに任意の名前で保存
    Dim fn As String
    fn = InputBox("ファイル名を入力")
    If fn = "" Then
        MsgBox "キャンセルされました。"
    Else
        WB.SaveAs ThisWorkbook.Path & "\" & fn & ".xlsx", XlFileFormat.xlOpenXMLWorkbook
    End If
    '閉じる
    WB.Close False
End Sub

Resume Nextでエラーチェックをサボっているので、偉い人には叱られるかもしれませんが、この程度の処理ならこれで十分でしょう。
（名無し） 2018/10/04(木) 13:26

名無しさん

ありがとうございます！！！
早速試してみたとところ、VBAのボタン(フォームコントロール)が残ってしまいました。。。
こちらは標準モジュールで作成しております。
何か理由がありますでしょうか。。。

（あかり） 2018/10/04(木) 15:01

何らかの理由で
試しにOn Error Resume Nextをコメントアウトしたらどうなりますか？
（先頭にシングルクォーテーションを付け足して 'On Error Resume Next として下さい）
消えないということは何らかのエラーが出ているはずです。

というか、消したいボタンというのは、マクロを呼び出したボタンだけですよね？
シート上に存在する全てのフォームコントロールを消したいという話なら

    WB.Worksheets(callShn).Shapes(callShp).Delete
の部分を
    Dim shp As Shape
    For Each shn In sheetNames
        For Each shp In WB.Worksheets(shn).Shapes
            If shp.Type = msoFormControl Then
                shp.Delete
            End If
        Next
    Next
に変えることで消すことが出来ます。
（名無し） 2018/10/04(木) 15:15

名無しさん

できました！！！！！
本当にありがとうございます。助かりました！
（あかり） 2018/10/05(金) 15:30

コメント返信：

[ 一覧(最新更新順) ]

[[20181002162851]] 『VBAで特定のシートだけを別ファイルで保存する方磨x（あかり） ページの最後に飛ぶ

[[20181002162851]]　『VBAで特定のシートだけを別ファイルで保存する方磨x（あかり）　ページの最後に飛ぶ