マクロ 特定列で抽出したデータを列ごとシート名を作成し、決まったセルに張り付けたい

シート1
商品名/商品コード/単価/備考/・・・
りんご/0001/100円/長野県
みかん/0002/200円/三重県
すいか/0003/250円/静岡県

抽出列は商品名
商品名でシート名を作成し、決まったセルにデータを貼り付ける
このようにマクロを作成したいです。

よろしくお願いします。

No.3 回答者： tatsu99 回答日時： 2016/11/04 16:58

以下のマクロを標準モジュールへ登録し実行してください。

----------------------------------------------
Option Explicit


Dim sh1 As Worksheet
Dim sh2 As Worksheet
Public Sub Macro1()
Dim rowmax1 As Long
Dim row As Long
Dim name As String
Set sh1 = Worksheets("sheet1")
rowmax1 = sh1.Cells(Rows.Count, 1).End(xlUp).row 'sheet1の最大行取得
Application.ScreenUpdating = False
For row = 1 To rowmax1
name = sh1.Cells(row, 1).Value
'商品名に対応するシートが
If ExistsWorkSheet(name) = True Then
'既にあれば上書き
Set sh2 = Worksheets(name)
Else
'なければ作成
Set sh2 = Worksheets.Add(after:=Worksheets(Worksheets.Count))
sh2.name = name
End If
'商品名
sh1.Cells(row, 1).Copy
sh2.Range("B1").PasteSpecial
'商品コード
sh1.Cells(row, 2).Copy
sh2.Range("C1").PasteSpecial
'単価
sh1.Cells(row, 3).Copy
sh2.Range("G1").PasteSpecial
'県名
sh1.Cells(row, 4).Copy
sh2.Range("B2").PasteSpecial
'備考
sh1.Cells(row, 5).Copy
sh2.Range("C2").PasteSpecial
Next
Application.CutCopyMode = False
Application.ScreenUpdating = True
End Sub

'ワークシートの存在チェック
Private Function ExistsWorkSheet(ByVal SheetName As String) As Boolean
Dim ws As Worksheet
ExistsWorkSheet = False
For Each ws In Worksheets
If ws.name = SheetName Then
ExistsWorkSheet = True
Exit Function
End If
Next ws
End Function
------------------------------------------
シート1の名称は標準で追加される"Sheet1"を使用しています。
もし、これを変えたい場合は、
Set sh1 = Worksheets("sheet1")
の箇所を実際のシート名に変えてください。

この回答へのお礼

ありがとうございます。
早速、試してみたいと思います。
本当にありがとうございました。

お礼日時：2016/11/04 17:10

No.2 回答者： tatsu99 回答日時： 2016/11/04 16:07

返信、ありがとうございました。

＞2の質問ですが、商品名（りんごの場合）りんごがシート1のA1のセルにあり
＞このデータをりんごのシートのB2のセルに貼り付けしたいです。
ということは、
１．シート１には見出しはないのですか。（A1がりんごなので）
それとも、A1はA2の誤りですか。
２．りんごのシートのB2に”りんご”を貼り付けますが、
他のセルは全て空白でも良いのですか。
（0001/100円/長野県は張り付けないで良いですか。1行目の見出しも不要ですか）

この回答へのお礼

1、見出しはないです。
2、他のセルもあります。
シート1
A1セル/B1セル/C1セル/D1セル/F1セル
りんご/0001/100円/長野県/備考

転写したいシート
まずシート名はAの列ごと
りんご
りんごシート
B1セルにりんご/C1セルに0001/G1セルに100円/B2セルに長野県/C2セルに備考
という感じに貼り付けたいです。
よろしくお願いします。

お礼日時：2016/11/04 16:17

No.1 回答者： tatsu99 回答日時： 2016/11/04 15:34

補足要求です。

質問１：商品名に重複はないですか。
質問２：”決まったセルにデータを貼り付ける”とは、
どのデータをどのセルに貼り付けるのですか。
商品名でシート名を作成したときの、そのシートのセルの情報を
提示してください。

この回答へのお礼

早速、ありがとうございます。
1の質問ですが、商品名は重複しません。
2の質問ですが、商品名（りんごの場合）りんごがシート1のA1のセルにあり
このデータをりんごのシートのB2のセルに貼り付けしたいです。
よろしくお願いします。

お礼日時：2016/11/04 15:50