EXCEL プログラム マクロ VBA シート 転記

質問

私はプログラム初心者です。
EXCELでマクロを組もうと思いましたが、皆目見当つかないので質問させて頂きました。

以下のようなことがしたいです。
・Sheet1にある内容を他のシートへ転記する
・他のシートの名前はポン酢、醤油、味噌、酢である。
・Sheet1には以下のようなデータ群がセルにはりつけられている
行A|行B|行C
管理番号|値段|調味料
1|100円|ポン酢
2|200円|醤油
3|900円|味噌
4|500円|酢
5|800円|味噌
6|(空白)|(空白)
7|2000円|酢

以上のデータをシートへ貼り付ける。
シートの名前はポン酢・醤油・味噌・酢であり、調味料の列に入っている名前から各シートへ転記する。
また、Sheet1に貼り付けられているデータで空欄の部分は飛ばすものとする。

シート転記例（味噌）
3|900円|味噌
5|800円|味噌
シート転記例（酢）
7|2000円|酢

どうぞ、よろしくお願いいたします。

回答No.4

hotosys · ベストアンサー

こんなのではどうでしょうか？
転記先のシートがあるものとしてます。
質問での転記先は1行目からなのでチェックしてますが見出しがあるようならその行は外してください。
Sub sample()
Dim srcSheet As Worksheet
Dim dstSheet As Worksheet
Dim srcRow As Long
Dim dstRow As Long
Set srcSheet = Sheets("Sheet1")
For srcRow = 2 To srcSheet.Range("C" & Rows.Count).End(xlUp).Row '元シートのデータ範囲で繰り返し(転記先シート名は必須なのでC列でチェック)
If srcSheet.Range("C" & srcRow).Value <> "" Then '調味料名(転記先シート名）が空白でない場合
Set dstSheet = Sheets(srcSheet.Range("C" & srcRow).Value) '転記先シート取得
dstRow = dstSheet.Range("A" & Rows.Count).End(xlUp).Row + 1 '転記先行取得
If dstSheet.Range("A1") = "" Then dstRow = 1 '質問で転記先には1行目からなので、それに対応
dstSheet.Range("A" & dstRow).Resize(1, 3).Value = srcSheet.Range("A" & srcRow).Resize(1, 3).Value 'データ転記
End If
Next
End Sub

p.s.
ちなみに元データのD列とかに転記したものは"済"とか入れて、転記済みかどうかのチェックを入れると重複転記をチェックできます。
それと・・・
>行A|行B|行C
ってのが分からないので無視しました。

お礼

動作を確認できました！
丁寧な回答ありがとうございます。

一つ一つソースコードを読み解いて理解していきたいと思います。
ありがとうございます。

回答No.3

n-jun

オートフィルタで抽出・コピー・ペーストの作業を、マクロの自動記録で行なってみる。
とかやってみてからの方が覚えていけるかも。。。

回答No.2

hige_082

まずは、禁止事項の丸投げ・依頼の項目をよく読んでください

上記の理由でサンプルを提示するだけにします

Sub test()
Dim コピー元シート, コピー先シート As Worksheet
Dim コピー元行, コピー先行 As Long
Set コピー元シート = Worksheets("sheet1")
コピー先行 = 0
For コピー元行 = 1 To コピー元シート.Range("a65536").End(xlUp).Row
Select Case True
Case コピー元シート.Range("c" & コピー元行).Value = "aaa"
Set コピー先シート = Worksheets("aaa")
コピー先行 = コピー先シート.Range("a65536").End(xlUp).Row + 1
Case コピー元シート.Range("c" & コピー元行).Value = "bbb"
Set コピー先シート = Worksheets("bbb")
コピー先行 = コピー先シート.Range("a65536").End(xlUp).Row + 1
Case コピー元シート.Range("c" & コピー元行).Value = "ccc"
Set コピー先シート = Worksheets("ccc")
コピー先行 = コピー先シート.Range("a65536").End(xlUp).Row + 1
End Select
If コピー先行 <> 0 Then
コピー先シート.Range("a" & コピー先行).Value = コピー元シート.Range("a" & コピー元行).Value
コピー先シート.Range("b" & コピー先行).Value = コピー元シート.Range("b" & コピー元行).Value
コピー先シート.Range("c" & コピー先行).Value = コピー元シート.Range("c" & コピー元行).Value
End If
コピー先行 = 0
Next コピー元行
Set コピー元シート = Nothing
Set コピー先シート = Nothing
End Sub

以上、エラー処理はしていません
＞私はプログラム初心者です。
基本が分っていれば、分かる程度のコードしか使用していません
＞EXCELでマクロを組もうと思いましたが、皆目見当つかないので質問させて頂きました。
分からないなら諦めて、折角サンプル作っても自分でアレンジ出来なければ意味が無い
後はご自分で

お礼

厳しい意見ありがとうございます。
確かにその通りです。
丸投げと言われても反論できません。

精進したいと思います。

回答No.1

alesi_sato

転記そのものが目的なのでしょうか？
もし、各商品の合計金額を出したいのなら、sumif関数を使ったほうがよっぽどシンプルで楽ですが、それではだめでしょか？