Excelで項目ごとにシートを振り分ける方法

Excelで項目ごとにシートを振り分けるには、マクロがいいと調べると出るのですが、Excel初心者の為マクロの作り方がわかりません。

画像のようにユニットごとに振り分けたいです。
振り分け後(画像右）の表の形？が多少変わっても構いません。

ユニット内のデータは多いもので100を超えます。

全ユニット数としては大体40前後あります。

どのようにマクロを作るのでしょうか？
また、初心者の為簡単な解説等あると助かります。

No.1 回答者： 銀鱗 回答日時： 2019/02/12 17:53

まずは手動で振り分ける手順をイメージする。

そのイメージ通りの手順をマクロ（VBA）で再現する。
そんだけです。
（記述したマクロを最適化することもありますが、必須ではありません）

手動で振り分けるイメージが無ければ、何もできません。
…たまにいるんですよ。「面倒だから全部代わりに作ってくれ」って人がね…

イメージができれば、あとはVBAの記述のルールを覚えましょう。
まずは
　「A1セルに数値を表示させる」
という超簡単な物から始めて、
　「B1セルからB10セルまでの合計をC1セルに表示する」
という他のセルを参照するような物を作りましょう。
あとは条件や処理を変えたものを作ることを覚えればOK。

・・・
そんなわけで、今はとりあえず手動で振り分けることを勧めます。
自分でマクロを記述できるようになるまで半年くらいはかかると思っておきましょう。

手動で振り分けを行う中で、Excelの便利な操作方法を覚えることもあるでしょう。
意外とマクロを使うよりも手動で処理したほうが早く確実に、しかも無駄なマクロを残さずに終わらせることができたりします。

No.2 回答者： mike_g 回答日時： 2019/02/12 20:40

添付図参照

新規ブックを開いて、下記の作業を始める前に必ず[名前を付けて保存]を実行しておくこと。此処ではブック名を仮に「るーち.xlsx」としておく。
Sheet1 において、
１．範囲 A4:E150 を選択 ⇒ Alt+MC ⇒ “上端行”のみにチェック入れ ⇒ [OK]

Sheet「9999」において、
１．次式をセル A5 に入力
￣￣=MID(CELL("filename",A1),FIND("]",CELL("filename",A1))+1,9999)*1
２．セル A7 に次式を入力
￣￣=IFERROR(INDEX(INDIRECT(A$6),SMALL(IF(Sheet1!$D$5:$D$20=$A$5,ROW(D$5:D$20)),ROW(A1))-4),"")
￣￣【お断り】この式は必ず配列数式として入力のこと
３．セル A7 を右３列にオートフィル
４．オートフィルされて入力されたセル D7 の式を下記のように変更
￣￣=IFERROR(INDEX(INDIRECT(A$4),SMALL(IF(Sheet1!$D$5:$D$20=$A$5,ROW(G$5:G$20)),ROW(D1))-4),"")
￣￣【お断り】この式も必ず配列数式として入力のこと。
￣￣￣￣￣￣￣ちなみに、変更した箇処は「A$4」のみで、元は「D$6」に
￣￣￣￣￣￣￣なってた
５．範囲 A7:D7 を下方にズズーッと(空白行が表示されるまで)オートフィル

No.3 回答者： mike_g 回答日時： 2019/02/12 21:09

[No.2]の提示式を下記のように変更します。

理由は、最初は Sheet1 のデータの行範囲を A5～E20 で考えていたが、質問文中の「ユニット内のデータは多いもので100を超えます」を見落としていたことに、後になって気付いたのです。
その時点で、ステップ１で「範囲 A4:E150 を選択」としたのだけど、Sheet2 における修正を忘れていた次第。

前置きが長くなったけど、要は下記のように変更されたい。

２．変更前: =IFERROR(INDEX(INDIRECT(A$6),SMALL(IF(Sheet1!$D$5:$D$20=$A$5,ROW(D$5:D$20)),ROW(A1))-4),"")
￣￣変更後: =IFERROR(INDEX(INDIRECT(A$6),SMALL(IF(INDIRECT($A$4)=$A$5,ROW(INDIRECT($A$4))),ROW(A1))-4),"")
４．変更前: =IFERROR(INDEX(INDIRECT(A$4),SMALL(IF(Sheet1!$D$5:$D$20=$A$5,ROW(G$5:G$20)),ROW(D1))-4),"")
￣￣変更後: =IFERROR(INDEX(INDIRECT(A$4),SMALL(IF(INDIRECT($A$4)=$A$5,ROW(INDIRECT($A$4))),ROW(D1))-4),"")

[No.2]および上に記した内容が貴方に珍紛漢なら、私の“怪答”は全部無視されたい。

No.4 回答者： tom04 回答日時： 2019/02/12 22:38

こんばんは！

VBAでの一例です。
オートフィルタで対応できると思います。
お示しの画像通りの配置で、シート見出しの2番目以降には「ユニット番号」名のシートが並んでいるとします。
標準モジュールです。

Alt＋F11キー　→　メニュー　→　挿入　→　標準モジュール　→　VBE画面のカーソルが点滅しているところに
↓のコードをコピー＆ペースト　→　Excel画面に戻り（VBE画面を閉じて）マクロを実行してみてください。
Alt＋F8キー　→　マクロ　→　マクロ実行です。

Sub Sample1() '//この行から//
　Dim k As Long, lastRow As Long
　Dim sN As String, wS As Worksheet
　　Application.ScreenUpdating = False
　　　With Worksheets("マスタ")
　　　　For k = 2 To Worksheets.Count
　　　　　Set wS = Worksheets(k)
　　　　　　sN = wS.Name
　　　　　　　lastRow = wS.Cells(Rows.Count, "A").End(xlUp).Row
　　　　　　　　If lastRow > 6 Then
　　　　　　　　　Range(wS.Cells(7, "A"), wS.Cells(lastRow, "E")).ClearContents
　　　　　　　　End If
　　　　　　　　lastRow = .Cells(Rows.Count, "A").End(xlUp).Row
　　　　　　　　.Range("A5").AutoFilter field:=4, Criteria1:=sN
　　　　　　　　　If .Cells(Rows.Count, "A").End(xlUp).Row > 4 Then
　　　　　　　　　　Range(.Cells(5, "A"), .Cells(lastRow, "E")).SpecialCells(xlCellTypeVisible).Copy
　　　　　　　　　　wS.Range("A7").PasteSpecial Paste:=xlPasteValues
　　　　　　　　　End If
　　　　　　　　wS.Range("A5") = sN
　　　　Next k
　　　　Application.CutCopyMode = False
　　　　.AutoFilterMode = False
　　　　.Activate
　　　End With
　　Application.ScreenUpdating = True
　　　MsgBox "完了"
End Sub '//この行まで//

こんな感じではどうでしょうか？m(_ _)m