データを入力すると各シートへの自動追加反映

Question

ExcelのSheet１にだけデータを入力すると各地区名のSheetに自動反映できるように
する方法を教えてください。

これと似たような質問があったのですが、VBAのことも詳しくないのでよくわかりませんでした。
関数でこれを行うと、新たなシートを増やしたりするときなどに大変だということがわかり、
VBAですると簡単にできるということはわかったのですが、何しろド素人のため（これから覚える気はあります。）ぜひ教えていただけたらと思いご指導お願いいたします。

tatsu99 · Accepted Answer

ほぼ、要件が確認できましたので、最終確認です。
１）シート名は、必ず青字の文字と一致する必要がありますが、それで良いでしょうか。
地区名＝貝塚西　の場合、シート名＝貝塚西　でなくてはいけません。シート名＝貝塚　はNGです。
マクロは、地区名からシート名を決定しますので、完全に一致しないと不都合が発生します。
（人間はシート名＝貝塚　でも判断可能ですが、そのようなあいまいなことを考慮して良きに計らうことをマクロはできません）

地区名＝阪堺・その他　の場合もシート名＝阪堺・その他 となります。

２）今回、追加された行をその地区の最後に反映するということですが、厳密にいうと、その行のみを処理することは難しいです。
そのシートが更新されたイベントを検知してその行を処理するとき、それが、追加された行なのか、（一旦登録した後で）修正された行なのかを
判断することができません。そのために、以下のような方法をとりますが、それでよろしいでしょうか。

①データを追加した後で、こちらから提示したマクロを明示的にあなたが実行する。
②マクロは、Sheet1の内容を全件（全地区分）処理する。（各地区のシートにデータを振り分ける）
従って、以前追加したものは、各地区のシートに上書きされます。結果的に、今回追加したぶんが、新しく追加されたようになります。

尚、追加データが複数ある場合は、Sheet1に追加データを全て書き込んだ後で、1回マクロを実行すれば、全て追加分が反映されるようになります。
（1件追加毎にマクロを呼び出す必要はありません）

２）上記のことを正しく実行する為には、Sheet1は、以下のようになっている必要がありますが宜しいでしょうか。
①各地区の最初には地区名（青字部分）が存在する。
②その地区内のデータ（黒字部分）が、その次の行から始まる。
③地区が変わる場合は、必ず、空白行が1行以上存在する。

３）地区名に対応したシートが必ず存在することが前提です。
Sheet1に新規に地区名が追加された場合は、その地区のシート（空のシート）も追加しておく必要がありますが宜しいでしょうか。

tatsu99 · Answer

>あと、ひとつ確認なんですが
>①データを追加した後で、こちらから提示したマクロを明示的にあなたが実行する。というのは
>２）と３）の状態にしたデータが完了したらtatsu99様に再度お知らせさせていただくということでよろしかったでしょうか。よろしくお願いいたします。

いえ、そうではなくて、私が提供するをあなたが実行するということです。
以下のマクロを標準モジュールに登録してください。
-----------------------------------------------------------
Option Explicit

Public Sub 各地区シートへ反映()
    Dim sh As Worksheet
    Dim ws As Worksheet
    Dim row As Long
    Dim row2 As Long
    Dim maxrow As Long
    Dim tiku As String
    Set sh = Worksheets("Sheet1")
    maxrow = sh.Cells(Rows.Count, 1).End(xlUp).row  '最終行の取得
    tiku = ""
    '先頭から最終行まで繰り返す
    For row = 1 To maxrow
        If sh.Cells(row, "A").Value = "" Then
            tiku = ""
        Else
            If tiku = "" Then
                '地区の先頭（地区名）
                tiku = sh.Cells(row, "A").Value
                Set ws = Worksheets(tiku)
                ws.Cells.Clear
                sh.Range("A" & row).Copy ws.Range("A1")
                row2 = 2
            Else
                '地区のデータ
                sh.Range("A" & row & ":D" & row).Copy ws.Range("A" & row2 & ":D" & row2)
                row2 = row2 + 1
            End If
        End If
    Next
    MsgBox ("完了")
End Sub
----------------------------------------------
手順としては、
①このマクロをそのブックの標準モジュールに登録
②Sheet1へデータを追加
③このマクロの実行

となります。
②は問題ないので、不明点があるとすれば、①③かと思います。
もし、①③で不明点があれば補足してください。

tatsu99 · Answer

No3です。各地区のシートの画像は１地区あれば十分ですので、それ以上は提示不要です。
ありがとうございました。いま、問題点をまとめていますので、しばらくお待ちください。

tatsu99 · Answer

No2です。
私が、お願いしているのは、
２）各地区名のSheetの画像の提示
３）Sheet1のどこに、何を入力すると、どの各地区のシートにどのように反映したいのかを具体的に提示
です。（Sheet1の赤字の箇所が、入力したデータで、それを反映したいように見えますが、よく読めません。）
Sheet1の6行目を各地区名のSheetに反映したいということでしょうか。
各地区名はA列ですか。そのA列の内容が各地区名のSheet名になっているのですか。
E～Hに書いてある赤い文字が読めません。なんて書いてありますか。
提示してほしいのは、そのような情報です。

１）Sheet1の画像の提示は、既に提示されているので、２）３）をお願いしています。

tatsu99 · Answer

No1です。私がお願いした補足要求は、
１）Sheet1の画像の提示
２）各地区名のSheetの画像の提示
３）Sheet1のどこに、何を入力すると、どの各地区のシートにどのように反映したいのかを具体的に提示
の３つです。
１）は補足されましたが、２）３）についてはまだ補足されていません。

tatsu99 · Answer

すみません。画像が小さすぎて良くわかりません。
Sheet1の画像と各地区名のSheetの画像を別々に提示してください。（そうすると大きな画像になります）
また、Sheet1にどこに、何を入力すると、どの各地区のシートにどのように反映したいのかも、具体的に書いてください。

データを入力すると各シートへの自動追加反映

ほぼ、要件が確認できましたので、最終確認です。

>あと、ひとつ確認なんですが

No3です。

No2です。

No1です。

すみません。

似たような質問が見つかりました

関連するカテゴリからQ&Aを探す

デイリーランキングこのカテゴリの人気デイリーQ&Aランキング

マンスリーランキングこのカテゴリの人気マンスリーQ&Aランキング