【VBA】シートコピーの実用例（WorkSheet操作）

こんにちは、今日はハンドスピナー製作に挑戦して子供達にダメ出しされたRyoです。
ここ最近は夏季休暇だったこともあって娯楽／趣味関連の記事投稿が多かったのですが、
仕事も始まったことですしVBA関連にまた力入れていきたいと思います。

Excelで仕事をしていると当然ながらワークシート複数になっていきますが、そのシートも
大別すると例えば基準A_Sheet、基準B_Sheet、基準C_Sheet等になっていて、それぞれの
基準Sheetに対しSheet(2)、Sheet（3）・・・のように複製されてたりします。

この場合、基準とするSheetの複製を含む集団からいずれかのSheetをコピーする場合、
コピー先はその集団の最後尾としたいものではないかと思います。
今回はその方法をサンプルコード含めてご紹介します。

1.サンプルイメージ
- ◆Sheet構成
2.サンプルコード
- ◆動作

1.サンプルイメージ

◆Sheet構成

仮にSheet構成が上図の形になっているものとします。
基準となるSheetは「SampleA」「SampleB」「SampleC」があり、
「SampleA」には複製が(2)～（4)、「SampleB」は複製(2）～（3）、「SampleC」は
複製(2)～(4)となっています。

今回のサンプルは以下の様な動作になります。
≪「SampleA」のコピー≫
AからA(4)までのどれをコピーしてもコピー先は「SampleB」の前位置とする。

≪「SampleB」のコピー≫
BからB(3)までのどれをコピーしてもコピー先は「SampleC」の前位置とする。

≪「SampleC」のコピー
CからC(4)までのどれをコピーしてもコピー先は「最後尾」とする。

要するに「同種のSheet最後尾をコピー先」とする処理になります。

2.サンプルコード

Sub SheetCopy()
  
    Dim i, cnt, strcnt As Integer
    Dim ShName, A, StrA As String

    ShName = ActiveSheet.Name
    strcnt = Len(ShName)
    
    '複製シートの(2)等の文字を除外する
    For i = 1 To strcnt
       A = Mid(ShName, i, 1)
         If A <> "(" Then
            StrA = StrA & A
          Else: Exit For
         End If
     Next i

    'シート名を置換
    ShName = StrA
    
    'ワークシート数分繰り返す
    For i = 1 To Worksheets.Count
        'ワークシートにコピー元の名前が含まれているか確認
        If InStr(Worksheets(i).Name, ShName) = 1 Then
             cnt = i
        End If
    Next i

  'コピー元が最後尾であれば、そのシートの次にコピー
  If Worksheets.Count = cnt Then
      Sheets(ActiveSheet.Name).Copy After:=Sheets(Worksheets.Count)
    Else
      'コピー元と同じ名前が含まれるシートの最後尾にコピー
      Sheets(ActiveSheet.Name).Copy After:=Sheets(cnt)
  End If

End Sub

先ず前提ですが、このサンプルコードの場合は基準とするSheet（本サンプルでは
SampleA～C）の名前は変えずに複製は基準Sheet名＋(n)となっているとします。

コードの解説ですが、最初にコピー元のSheet名を読み込み文字数をLenにて取得します。
ShName = ActiveSheet.Name

strcnt = Len(ShName)

次に文字数分繰り返し処理を行い、複製Sheetの場合に含まれる(n)を含まないSheet名に
置換します。
この処理は次に行うInStr関数で同名Sheetをカウントさせる為に行っています。
For i = 1 To strcnt
A = Mid(ShName, i, 1)　’先頭から1文字ずつ抜取り
If A <> “(” Then
StrA = StrA & A 　’”（”までの間、StrAに文字を結合していく
Else: Exit For
End If
Next i

ShName = StrA

コピー先Sheet名の置換後、全Sheetに対し照合を行い置換したSheet名が含まれる場合は
その数をカウントします。
ここでカウントするのはSheetの位置を把握する為で、Sheet操作の場合は左から順に
1,2,3・・・と割り振られています。

エディタ画面プロジェクトウィンドウ内に表示されているSheetに続く数字と勘違いしやすいのですが、上述の通りなので本サンプルの場合で言えばSampleA、A(2)、A(3)、A(4)が
１，２，３，４となるということです。
For i = 1 To Worksheets.Count ‘ワークシートにコピー元の名前が含まれているか確認
If InStr(Worksheets(i).Name, ShName) = 1 Then
cnt = i
End If
Next i

Sheetのカウントが終われば、後はその数値に基づいてコピー先を判定するのみです。
WorkSheets.Countがcntと同一であればコピー元は最後尾に位置しているので、
以下の様にコピー先を最後尾位置にします。
If Worksheets.Count = cnt Then
Sheets(ActiveSheet.Name).Copy After:=Sheets(Worksheets.Count)

それ以外はコピー元と同じ名前が含まれるSheet集団の最後尾をコピー先とします。
Else
Sheets(ActiveSheet.Name).Copy After:=Sheets(cnt)
End If