Excel シートの新規挿入とかコピーをたくさん同時に実施する方法普通の操作とかマクロとか

のっけからいきなり萎えるようなことを書くけど、今回紹介するExcel操作テク及び自作マクロは、正直言って使える場面は非常に少ないだろう。

書きたくて色々と温めているExcelネタはあるのだけど、長くて書くのに時間が掛かりそうなものばかりなので、それらを書くまでのつなぎのようなものです(マクロの記事全般が実はそれです)。

それでは今回のネタについて。
Excelを使っていて、1日～31日までのシートなど多数のシートが必要になって、

まったく新しく、まっさらのシートを一度に何十枚も挿入したい。
「1日」シートを作ったからそれを31枚コピーするというように、シートを一度に何十枚もコピーしたい。

といったケースはないだろうか。

まあ無いかもしれないね。私にもそんな機会は多くない。
今回は、そういった沢山のシートを一度に手っ取り早く挿入する方法を、マクロも含めて紹介する。

シートの挿入やコピーの基本操作

まずそもそも、Excelのシートを新規挿入する方法と、アクティブシートをコピーする方法から。

新規シートの挿入

普通にシートを挿入するにはShift+ F11というショートカットキーがあって、これを知らないと給料泥棒だ。
そして今回の題材のひとつ、多数のシートを新規挿入するってやつは、そのShift+ F11を連打するだけでもかなり何とかなる。

次に、Excelのシート見出しの右端に「+」マークのボタンがあって、これを押すことでも新規シートを挿入することができる。

私もこの「+」ボタンでシート挿入をすることが多いけど、多数のシート挿入っていうのはこれでは難しいだろうね。

他にもリボンの「ホーム」タブからやる方法もあるけど、そんなのは知らなくていいから省略。

シートのコピー

次に、既存のシートをコピーした新しいシートを作成する方法。

私が最もよく使うのは、Ctrlキーを押しながらシート見出しを左か右にドラッグするというやり方。
Ctrlキーを押さずにやるのは、シートをコピーするんじゃなくて移動するって操作になる。

他に、多くの人がやるのは、

シート見出しを右クリック
→「移動またはコピー」
→次の画面で「コピーを作成する」にチェックを入れ「OK」

という操作だ。

ただこのやり方は、右クリックメニューを使うので遅く、オススメしない。
別のブックにコピーするときは、私もこのやり方を使うことが多いけどね。

で、このシートのコピーってやつは、沢山の枚数コピーしまくるのは難しい。
そんな操作が必要な機会が多いとも思えないけど。

マクロ

それでは今回の題材
(1)新規シートを多数挿入する
(2)シートのコピーを多数作成する
を実施するマクロのソースコードを下記に示す。

何となく作成してみたら、ソースコードを両者共通に使い回せる部分が多かったので、今回同時に紹介することにしたわけだ。

Sub Exe_AddMultipleSheets(n As Long)
'n=1:枚数を指定して新規シートを追加する
'n=2アクティブシートを、枚数を指定してコピーする
    Dim ws                  As Worksheet
    Dim sheetsNum           As Variant
    Dim i                   As Long
    Dim wsIndex             As Long
    Dim msg                 As String
    
    Select Case n
        Case 1 '枚数を指定して新規シートを追加する
            msg = "新規挿入したいシートの枚数を入力して下さい。"
        Case 2 'アクティブシートを、枚数を指定してコピーする
            msg = "アクティブシートをコピーします。コピー数を入力して下さい。"
    End Select
    
    
    'Application.InputBoxのType:=1→数値を指定
    sheetsNum = Application.InputBox(msg, Title:="シート枚数", Default:=1, Type:=1)
    
    If VarType(sheetsNum) = vbBoolean Then Exit Sub  'キャンセルボタンを押された場合
    
    sheetsNum = Int(sheetsNum) '小数が入力された場合のため、整数に直す
    
    Set ws = ActiveSheet 'アクティブシート
    wsIndex = ws.Index 'アクティブシートの位置番号
    
    Select Case sheetsNum
        Case Is ＜＝ 0
            MsgBox "1以上の整数を入力して下さい。", vbExclamation, "数値不足"
        Case Else
            Application.ScreenUpdating = False '描画を中断
            For i = 1 To sheetsNum
                Select Case n
                    Case 1 '枚数を指定して新規シートを追加する
                        Worksheets.Add after:=Worksheets(wsIndex + i - 1)
                    Case 2 'アクティブシートを、枚数を指定してコピーする
                        ws.Copy after:=Worksheets(wsIndex + i - 1)  'シートコピー
                End Select
            Next i
            
            Application.ScreenUpdating = True '描画を再開
            MsgBox sheetsNum ＆ "枚のシートを追加しました。", vbInformation, "処理終了"
    End Select
 
End Sub
 
Sub insertMultipleSheets()
'枚数を指定して新規シートを追加する
    Call Exe_AddMultipleSheets(1)
End Sub
 
Sub copyCurrentSheet()
'枚数を指定してシートをコピーする
    Call Exe_AddMultipleSheets(2)
End Sub