• 虹色ミツバチ
  • freoカスタマイズメモ、テンプレート・プラグイン配布/officeTIPS
検索プラグイン
虹色ミツバチ

> Entry >MOS>Microsoft Office Excel>マクロ/VBA> 特定のシートをコピーして別のワークブック(CSVファイル)として保存するVBA例

【MOS】【Microsoft Office Excel】【マクロ/VBA】特定のシートをコピーして別のワークブック(CSVファイル)として保存するVBA例

特定のシートをコピーして、別のワークブック(CSVファイル)として保存するときのコードサンプルです。
新しく作成するファイル名は、シート1のA1セルの値とします。

Sub Save_Copy_Sheet()
'====================================================================================
' 特定のシートをコピーして別のワークブック(CSVファイル)として保存するマクロ
'====================================================================================
    '//変数の定義
        Dim newFileName, newFileFolder, newFile As String
        Dim ShCopy As Worksheet
        Set ShCopy = Worksheets(1)                            '保存するシート
        newFileName = ShCopy.Range("A1").Value                '新しいファイルのファイル名
        newFileFolder = ThisWorkbook.Path                     '新しいファイルの保存先フォルダ名
        newFile = newFileFolder & "\" & newFileName & ".csv"  '新しいファイルをフルパスで定義
    '//新しいファイルと同名のファイルが開かれていないか確認
        On Error Resume Next
        Open newFile For Append As #1
        Close #1
        If Err.Number > 0 Then
            '//生成しないで終了
                MsgBox "生成するCSVと同名のファイルがすでに開かれています。" & vbCrLf & newFileName & ".csvファイルを閉じてやり直してください。"
                Workbooks(newFileName & ".csv").Activate
        Else
            '//処理を続行
                '//エラーダイアログを表示しない
                    Application.DisplayAlerts = False
                '//保存するシートをコピー
                    ShCopy.Copy
                '//コピーしたシートを新しいファイルとして保存
                    ActiveWorkbook.SaveAs fileName:=newFile, FileFormat:=xlCSV
                '//新しいファイルを閉じる
                    ActiveWindow.Close
                '//エラーダイアログを表示する
                    Application.DisplayAlerts = True
                '//終了メッセージ
                    MsgBox ("ファイルの作成に成功しました。")
        End If
End Sub

ワンポイント

CSV形式ではなく、XLSX形式で保存するときは、11行目及び18行目の「csv」を「xlsx」に変更してください。
また、27行目を下記の通り変更してください。
                '//コピーしたシートを新しいファイルとして保存
                    ActiveWorkbook.SaveAs fileName:=newFileFolder & "\" & newFileName & ".xlsx", FileFormat:=xlOpenXMLWorkbook

ページ移動

関連記事

ユーティリティ

Twitter

ページ上部へ