大体でIT

－ちょっと使えるネタを紹介－

HOME >  Excel VBA >  ワークシート操作
大体でIT

Excel VBAで、部署ごとで別シートに転記するには、「.AutoFilter」で各部署を抽出して、「.Copy」で別シート転記するとできます。「部署リスト」を作成して、部署ごとで別シート転記すると便利です。部署毎に別シート転記する方法について、マスターしていきましょう。

はじめに

この記事では、部署ごとに別シート転記する方法について、ご紹介します。

部署ごとに転記するには、次のような手順になります。

  • 部署リストを作成してループする
  • 部署でフィルタする
  • シートを追加
  • 追加したシート名を変更
  • フィルタ結果をコピー

という感じです。

では、部署ごとに別シート転記する方法について、解説していきます。

こちらの記事を読むメリット

  • 部署ごとに別シートに転記する方法がわかります。

本記事の内容を動画でまとめています。

本記事の内容を動画でまとめています。

VBAコードの作成手順について、動画で確認することができます。

こちらの記事も参考になります

目次から見たい項目へ移動すると便利ですよ。

目次

部署ごとに別シートに転記したい

部署ごとに別シート転記する方法について、ポイントごとにVBAコードを作成していきます。

やりたい内容

やりたい内容は、部署ごとで別シートに転記したい、ということになります。

部署ごとに別シート転記したい

こちらの部署のデータを、部署ごとに別シートに転記したいです。

やりたい内容は、部署ごとで別シートに転記したい、ということになります

こんな感じで、部署ごとで別シートに転記してみます。

こんな感じで、部署ごとで別シートに転記してみます

では、段階的にVBAコードを作成していきます。

VBAコードを作成

まずは、「営業部」のみを別シートに転記してみます。

「営業部」のみを別シートに転記

「営業部」のみを別シートに転記するVBAコードになります。

Sub TEST1()
  
  '「営業部」でフィルタ
  Range("A1").AutoFilter 1, "営業部"
  'シートを追加
  Sheets.Add after:=Sheets(Sheets.Count)
  ActiveSheet.Name = "営業部" 'シート名を変更
  'フィルタ結果を転記
  Sheets("Sheet1").Range("A1").CurrentRegion.Copy Range("A1")
  Sheets("Sheet1").Range("A1").AutoFilter 'オートフィルタを解除
  
End Sub

では、ポイントごとに実行していきます。

VBAコードを実行してみる

「営業部」でフィルタします。

「営業部」でフィルタします

シートを追加します。

シートを追加します

追加したシート名を変更します。

追加したシート名を変更します

フィルタ結果を追加したシートに転記します。

フィルタ結果を追加したシートに転記します

オートフィルタを解除します。

オートフィルタを解除します

これで、「営業部」を別シートに転記できます。

「営業部」を別シートに転記できた

「営業部」を別シートに転記できました

「営業部」を別シートに転記できました。

すべての部署を別シートに転記

次は、すべての部署を別シートに転記してみます。

先ほど作成したVBAコードを「For～Next」でループする感じです。

Sub TEST2()
  
  Dim A
  '部署リストを作成
  A = Array("営業部", "企画部", "総務部")
  
  For i = 0 To UBound(A)
    '部署でフィルタ
    Sheets("Sheet1").Range("A1").AutoFilter 1, A(i)
    'シートを追加
    Sheets.Add after:=Sheets(Sheets.Count)
    ActiveSheet.Name = A(i) 'シート名を変更
    'フィルタ結果を転記
    Sheets("Sheet1").Range("A1").CurrentRegion.Copy Range("A1")
    Sheets("Sheet1").Range("A1").AutoFilter 'オートフィルタを解除
  Next
  
End Sub

では、ポイントごとに実行してみます。

部署ごとに別シートに転記できる

「営業部」のデータが別シートに転記されます。

「営業部」のデータが別シートに転記されます

「企画部」のデータが別シートに転記されます。

「企画部」のデータが別シートに転記されます

「総務部」のデータが別シートに転記されます。

「総務部」のデータが別シートに転記されます

こんな感じで、部署ごとに別シートに転記することができます。

部署リストを作成して、部署ごとに別シート転記

次は、「部署リスト」を作成して、部署ごとに別シート転記してみます。

最初の方に、「Dictionary」を使って、重複しない部署リストを作成するVBAコードを追加します。

Sub TEST3()
  
  Dim B
  '辞書を作成
  Set B = CreateObject("Scripting.Dictionary")
  
  With Sheets("Sheet1")
    '部署をループ
    For i = 2 To .Cells(Rows.Count, "A").End(xlUp).Row
      '辞書に登録されていない場合
      If B.exists(.Cells(i, "A").Value) = False Then
        '辞書に登録
        B.Add .Cells(i, "A").Value, 0
      End If
    Next
  End With
  
  Dim A
  A = B.keys '部署リストを取得
  
  For i = 0 To UBound(A)
    '部署でフィルタ
    Sheets("Sheet1").Range("A1").AutoFilter 1, A(i)
    'シートを追加
    Sheets.Add after:=Sheets(Sheets.Count)
    ActiveSheet.Name = A(i) 'シート名を変更
    'フィルタ結果を転記
    Sheets("Sheet1").Range("A1").CurrentRegion.Copy Range("A1")
    Sheets("Sheet1").Range("A1").AutoFilter 'オートフィルタを解除
  Next
  
End Sub

では、実行してみます。

部署リストを作成して部署ごとに転記できる

実行すると、部署リストを作成できます。

部署リストを作成できます

部署リストを使って、部署ごとで別シートに転記できます。

部署リストを使って、部署ごとで別シートに転記できました

部署リストを使って、部署ごとで別シートに転記できました。

「Dictionary」を使って、「部署リスト」を自動で作成できれば、追加したデータも同じVBAコーで別シートに転記することができます。

データを追加して実行してみる

データを追加してみます。

データを追加してみます

では、先ほどと同じVBAコードを実行してみます。

追加したデータを、同じVBAコードで別シートに転記できました

追加したデータを、同じVBAコードで別シートに転記できました。

おわりに

この記事では、部署ごとに別シート転記する方法について、ご紹介しました。

部署ごとに転記するには、次のような手順になります。

  • 部署リストを作成してループする
  • 部署でフィルタする
  • シートを追加
  • 追加したシート名を変更
  • フィルタ結果をコピー

という感じです。

実務では条件別に別シートに転記したい、といった場面があるかと思います。

条件別に別シートに転記する方法について、マスターしていきましょう。

参考になればと思います。最後までご覧くださいまして、ありがとうございました。

関連する記事から探す

カテゴリから探す

カテゴリから見たい項目を探すと便利ですよ。

サイト内を検索する

↓キーワードを入力する

アーカイブから探す