VBA 303号室:シートを指定してコピー

Excel内のシートを指定してシートの末尾にコピーして指定したシート名に変える

Kappo

302号室の「Excelシートの指定削除」に続いて、プログラム速度的には302号室の方法より少しもっさりしますが、ベースフォームを軽くしたい場合はこの方法でおこなうといいですよ！！
この部屋ではコピー先が全シートの末尾にコピーしますが、シートを指定すると任意の位置にコピーが可能にります
※Afterに設定するためにサブルーチンの引数を追加する
試してみてね！！
また、一番したの方にコメント欄があるからよかったら質問・感想などメッセージ入れてください

Excel内のシートを指定してコピーするプログラム
呼び出すプログラム（例）
プログラムの実行

Excel内のシートを指定してコピーするプログラム

●●サブルーチンプログラム●●
標準モジュール（SheetCtrl）にブログラムを記述
※標準モジュールの追加は「Excelシート内で指定した描画オブジェクトの名前を取得するプログラム」を参照してください

サブルーチンの内容
SheetCopy(copyName As String, reName As String)
引数：copyName = コピー元のシート名、reName = コピーしたシートのリネーム名
戻り：0＝正常終了、1＝コピー元のシートが無い、2＝変える名前を同じシート名がある

▼プログラム▼

Public Function SheetCopy(copyName As String, reName As String)

    Dim Ret As Integer

    Ret = 0

    '------------------------------------
    'シート名の各存在を確認
    Dim Buf1 As String    'シートチェック用の代入変数
    Dim Buf2 As String    'シートチェック用の代入変数

    On Error Resume Next    'エラーがあっても続行指定

    Buf1 = Sheets(copyName).Name

    If Err.Number > 0 Then    'エラーが有った場合は値がある

        Ret = 1    'コピーシート名が存在していない

    Else

        Buf2 = Sheets(reName).Name

        If Err.Number = 0 Then    'エラー無かった場合は0になる

            Ret = 2    '変える名前と同じシート名がある

        Else

            '--------------------
            'シートのコピー

            Worksheets(copyName).Copy After:=Sheets(Sheets.Count)    'シートを最後尾にコピー

            Worksheets(Sheets.Count).Name = reName   'コピーしたシートの名前を変える

            '--------------------
        End If

    End If

   '------------------------------------

     SheetCopy = Ret

    '------------------------------------
 
End Function

呼び出すプログラム（例）

サブルーチンプログラムが出来たので呼びだすコマンドボタンを配置してプログラムを記述する

コマンドボタンがクリックされた時に実行されるプログラム
「CommandButton7」
※ボタンの配置方法は「VBA：描画オブジェクトの名前取得」を参照してください

シート名＝”Sheet2”を指定してコピーして、コピーしたシート名を”SheetNew”にリネームする

▼プログラム▼

Dim ret As Integer

ret = SheetCopy("Sheet1", "SheetNew")

If ret = 1 Then

    Call MsgBox("コピーシート名のエラー", vbCritical+vbOKOnly, "エラー")

ElseIf ret = 2 Then

    Call MsgBox("リネームシート名のエラー", vbCritical+vbOKOnly, "エラー")

Else

    Call MsgBox("正常にコピーされた", vbInformation+vbOKOnly, "メッセージ")

EndIf