マクロについて教えてください
マクロの超初心者です。
数式を入力しているのではなく、配付物をエクセルで作成しているのですが、同じもの(氏名や項目は違いますが)を100枚ほど作成しているのでマクロを・・・と思ったのですがやり方が全く分かりません。
sheet1からsheet2に下記のようにデータを写したいのですが、やり方を教えてください。
●氏名が入力されています
sheet1(A9) → sheet2(C2)
sheet1(E9) → sheet2(C5)
sheet1(I9) → sheet2(C8)
●項目1
sheet1(A8) → sheet2(E3)
sheet1(E8) → sheet2(E6)
sheet1(I8) → sheet2(E9)
●項目2
sheet1(A18~D18の結合セル) → sheet2(E2)
sheet1(E18~H18の結合セル) → sheet2(E5)
sheet1(I18~L18の結合セル) → sheet2(E8)
と反映させたいのですが、250行あるのですが、
簡単にマクロで出来ないでしょうか??
ちなみに↓コレが上記の内容で作ってみたものです。
わかりずらい質問でスイマセン。
Range("A9").Select
Selection.Copy
Sheets("sheet2").Select
Range("C2").Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Sheets("sheet1").Select
Range("E9").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("sheet2").Select
Range("C5").Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Sheets("sheet1").Select
Range("I9").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("sheet2").Select
Range("C8").Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Sheets("sheet1").Select
Range("A8").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("sheet2").Select
Range("E3").Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Sheets("sheet1").Select
Range("E8").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("sheet2").Select
Range("E6").Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Sheets("sheet1").Select
Range("I8").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("sheet2").Select
Range("E9").Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Sheets("sheet1").Select
Range("A18:D18").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("sheet2").Select
Range("E2").Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Sheets("sheet1").Select
Range("E18:H18").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("sheet2").Select
Range("E5").Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Sheets("sheet1").Select
Range("I18:L18").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("sheet2").Select
Range("E8").Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
End Sub
お礼
okormazdさん、回答ありがとうございました。 補足に書かせて頂きましたが、一つだけうまくいきません。 教えて頂けませんか。 よろしくお願いします。
補足
okormazdさんが、回答ありがとうございました。 すごい短くなるんですね~ 教えて頂いたのを早速実行させて頂きました。 (結果) 「Data!FB63376,FG63376,FJ63376」⇒「Data!K4,L4,M4」へコピー 「Data!FP63367:FR63372」⇒「拾い出し!O4」へコピー (希望) 「Data!FB63376,FG63376,FJ63376」⇒「拾い出し!K4,L4,M4」へコピーしたいです。 二つ共 With Sheets("拾い出し")に しているのに、片方は「Data!K4,L4,M4」に、片方は「拾い出し!K4,L4,M4」になります。どこがいけないのでしょうか? Sub Macro1() Range("FB63376,FG63376,FJ63376").Copy With Sheets("拾い出し") If Range("K4").Value = "" Then Range("K4").PasteSpecial Paste:=xlPasteValues Else Range("K" & Rows.Count).End(xlUp).Offset(1).PasteSpecial Paste:=xlPasteValues End If End With Range("FO63367:FQ63372").Copy With Sheets("拾い出し") If Range("P4").Value = "" Then .Range("P4").PasteSpecial Paste:=xlPasteValues Else .Range("P" & Rows.Count).End(xlUp).Offset(1).PasteSpecial Paste:=xlPasteValues End If End With End Sub 申し訳ありませんが教えて頂けませんか?