データを各シートに自動振り分け

質問

データシートA2にデータを貼付けると営業所ごとに各シートにデータを振分してほしいです。データシートは都度上書きとなりますが、振分用シートのデータは上書せずに、最後の行から挿入させたいです。品番が重複するデータが挿入された場合、新しいデータを削除。振分用シートはすべて、５行目が項目行となります。
どのようなコードを作成すればよいのかVBAに詳しい方、アドバイスよろしくお願いいたします。

回答No.2

kkkkkm

> 品番が重複するデータが挿入された場合、新しいデータを削除

古いデータを残すということで、営業所のシートは作成済みとして以下のような感じでいかがですか。

Sub Test()
Dim c As Range
Dim Sh1 As Worksheet, Sh2 As Worksheet
Dim FRange As Range

Set Sh1 = Sheets("データ")
For Each c In Sh1.Range(Sh1.Cells(2, "A"), Sh1.Cells(Rows.Count, "A").End(xlUp))
Set Sh2 = Sheets(c.Text)
Set FRange = Sh2.Range(Sh2.Cells(6, "C"), Sh2.Cells(Rows.Count, "C").End(xlUp)). _
Find(What:=c.Offset(0, 2).Value, LookIn:=xlValues, lookat:=xlWhole)
If FRange Is Nothing Then
Sheets(c.Text).Cells(Rows.Count, "A").End(xlUp).Offset(1, 0).Resize(1, 10).Value = _
c.Resize(1, 10).Value
End If
Set Sh2 = Nothing
Next
Set Sh1 = Nothing
End Sub

補足

コードを考えていただきありがとうございます。試してみたところSet Sh2 = Sheets(c.Text)でデバッグがおきたのですが、何が原因なのでしょうか(>_<)？

回答No.1

gennya

>データシートA2にデータを貼付けると営業所ごとに各シートにデータを振分してほしいです。

営業所ごとにデータを取り出すコードを書く

>データシートは都度上書きとなりますが、振分用シートのデータは上書せずに、最後の行から挿入させたいです。

最後の行を見つけるコードを書く
そこにデータを追加するコードを書く

>品番が重複するデータが挿入された場合、新しいデータを削除。

重複品番がないか見つけるコードを書く
その行を覚えておき、そこを消すコードを書く

>振分用シートはすべて、５行目が項目行となります。

6行目から追加するコードを書く