VBAを使って1つの表をデータ別に複数のシートに分割する方法

2023年4月15日

Excelで一つの表にまとめられたデータをある項目ごとに分割して複数のシートに振り分ける方法をご紹介します。手作業だと手間のかかる作業になりますが、VBAを使うとボタンをワンクリックするだけで作業を完了させることができます。具体的な処理手順は以下の通りです。

サンプルアプリの実行手順

下記赤枠のボタンをクリックすると処理が実行され、この下に掲載しているようにシートごとに表が分割されます。

赤枠の勤務地のデータをもとに各シートに表が分割されます。

具体的なやり方としてはVBAで次のように各シートの定義とオブジェクトを作成して
作成したオブジェクトに対して操作します。

　’ワークシート変数の定義
　 Dim Ws1, Ws2, Ws3, Ws4 As Worksheet
　’Worksheetオブジェクトを取得
　 Set Ws1 = Worksheets(“通勤手当一覧")
　 Set Ws2 = Worksheets(“東京")
　 Set Ws3 = Worksheets(“埼玉")
　 Set Ws4 = Worksheets(“新潟")

VBAコードの内容と解説は下記「サンプルコードの処理内容」及び「サンプルコード」を参照ください。
また、Worksheetオブジェクトのメソッドとプロパティ一覧については下記リンク先からご覧になれます。

　　Worksheetオブジェクト メソッド/プロパティ一覧

サンプルコードの処理内容

処理の内容については以下の通りです。

各種変数の定義
　　　　　↓
各ワークシートオブジェクトの取得
　　　　　↓
既存データの削除
　　　　　↓
各シートに表項目行をコピー
　　　　　↓
元データの勤務地を確認しながら該当シートにデータをコピー （ループ処理）
　　　　　↓
元データシートのA1セルを選択
　　　　　↓
処理完了メッセージの表示

サンプルコード 　　　アプリの作成手順はこちら

Option Explicit

Sub データ振り分け()

  '行カウント変数の定義
   Dim i As Integer
  '各シートのデータ最終行番号を入れる変数の定義
   Dim Ws1End, Ws2End, Ws3End, Ws4End As Integer
  'ワークシート変数の定義
   Dim Ws1, Ws2, Ws3, Ws4 As Worksheet
  
　'Worksheetオブジェクトを取得  
   Set Ws1 = Worksheets("通勤手当一覧")
   Set Ws2 = Worksheets("東京")
   Set Ws3 = Worksheets("埼玉")
   Set Ws4 = Worksheets("新潟")

'既存のデータを削除

  '東京シート
    '既存データの最終行の取得
     Ws2End = Ws2.Cells(Rows.Count, 2).End(xlUp).Row
    
    '既存データがあったらデータ削除
     If Ws2End > 5 Then
       Ws2.Range("B5:G" & Ws2End).Delete Shift:=xlShiftUp
     End If

  '埼玉シート
   '既存データの最終行の取得
    Ws3End = Ws3.Cells(Rows.Count, 2).End(xlUp).Row
    
   '既存データがあったらデータ削除
    If Ws3End > 5 Then
      Ws3.Range("B5:G" & Ws3End).Delete Shift:=xlShiftUp
    End If

  '新潟シート
   '既存データの最終行の取得
    Ws4End = Ws4.Cells(Rows.Count, 2).End(xlUp).Row
       
   '既存データがあったらデータ削除
    If Ws4End > 5 Then
      Ws4.Range("B5:G" & Ws4End).Delete Shift:=xlShiftUp
    End If


'各シートに表の項目行をコピー
  
  '東京シートに項目行をコピー
   Ws1.Range("B5:G5").Copy Ws2.Range("B5")
  
  '埼玉シートに項目行をコピー
   Ws1.Range("B5:G5").Copy Ws3.Range("B5")

  '新潟シートに項目行をコピー
   Ws1.Range("B5:G5").Copy Ws4.Range("B5")


'各シートにデータコピー

  '振り分け元データの先頭位置設定
   i = 6
  '振り分け元データの最終行の位置取得
   Ws1End = Ws1.Cells(Rows.Count, 2).End(xlUp).Row

  '振り分け元データの勤務地を確認しながら該当するシートにデータをコピー
  
  '振り分け元データの６行目からデータ最終行までループ処理
   For i = 6 To Ws1End
   
   '勤務地名に「東京」が入っていたら
    If InStr(Ws1.Cells(i, 6), "東京") > 0 Then
    
     '「東京」シートのデータ最終行を取得する
      Ws2End = Ws2.Cells(Rows.Count, 2).End(xlUp).Row
     '元データを「東京」シートにコピーする
      Ws1.Range("B" & i & ": G" & i).Copy Ws2.Range("B" & Ws2End + 1 & ": G" & Ws2End + 1)
    
   '勤務地名に「埼玉」が入っていたら
    ElseIf InStr(Ws1.Cells(i, 6), "埼玉") > 0 Then
   
     '「埼玉」シートのデータ最終行を取得する
      Ws3End = Ws3.Cells(Rows.Count, 2).End(xlUp).Row
     '元データを「埼玉」シートにコピーする
      Ws1.Range("B" & i & ": G" & i).Copy Ws3.Range("B" & Ws3End + 1 & ": G" & Ws3End + 1)
      
   '勤務地名に「新潟」が入っていたら
    ElseIf InStr(Ws1.Cells(i, 6), "新潟") > 0 Then
   
     '「新潟」シートのデータ最終行を取得する
      Ws4End = Ws4.Cells(Rows.Count, 2).End(xlUp).Row
     '元データを「新潟」シートにコピーする
      Ws1.Range("B" & i & ": G" & i).Copy Ws4.Range("B" & Ws4End + 1 & ": G" & Ws4End + 1)
   
    End If
   
   Next
       
 '「通勤手当一覧」シートのA1セルを選択して終了する
  Ws1.Range("A1").Select

 '処理完了メッセージの表示
  MsgBox "処理が完了しました。"

VBA,ループ処理,表の加工,集計処理Excel,VBA,サンプルアプリ,シート操作,マクロ

Posted by CoderM