Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちら をご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。

  新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム  
808 / 13645 ﾂﾘｰ ←次へ　｜　前へ→
▼ 【78202】このマクロを1つにまとめたいんですが ［名前なし］ 16/5/25(水) 17:05 質問[未読]
【78203】Re:このマクロを1つにまとめたいんですが β 16/5/25(水) 17:59 発言[未読]
【78208】Re:このマクロを1つにまとめたいんですが ［名前なし］ 16/5/26(木) 10:10 お礼[未読]
【78204】Re:このマクロを1つにまとめたいんですが β 16/5/25(水) 22:09 発言[未読]
【78202】このマクロを1つにまとめたいんですが
質問  ［名前なし］  - 16/5/25(水) 17:05 -
引用なし
パスワード
   Sheet2の「A2」〜「K2」、「O2」〜「W2」、「L2」〜「N2」の最終行までコピーを
Sheet1の「B2」にSheet2の「A2」〜「K2」に貼り付ける、Sheet1の「M2」にSheet2の「O2」〜「W2」、Sheet1の「V2」にSheet2の「L2」〜「N2」に貼りつけるマクロを1つにまとめたいのですが、いろいろ調べてみても見つかりませんでした。

Sub test()

　　'Sheet2の「A2」〜「K2」の最終行までコピー
　　Sheets("Sheet2").Select
　　Range("A2:K2").Select
　　Range(Selection, Selection.End(xlDown)).Select
　　Selection.copy
　　'Sheet1の「B2」に貼り付け
　　Sheets("Sheet1").Select
　　Range("B2").Select
　　ActiveSheet.paste

　　'Sheet2の「O2」〜「W2」の最終行までコピー
　　Sheets("Sheet2").Select
　　Range("O2:W2").Select
　　Range(Selection, Selection.End(xlDown)).Select
　　Selection.copy
　　'Sheet1の「M2」に貼り付け
　　Sheets("Sheet1").Select
　　Range("M2").Select
　　ActiveSheet.paste

　　'Sheet2の「L2」〜「N2」の最終行までコピー
　　Sheets("Sheet2").Select
　　Range("L2:N2").Select
　　Range(Selection, Selection.End(xlDown)).Select
　　Selection.copy
　　'Sheet1の「V2」に貼り付け
　　Sheets("Sheet1").Select
　　Range("V2").Select
　　ActiveSheet.paste

End Sub

自分で上のマクロを1つにまとめましたが、エラーがでます。
上手く1つにまとめる方法はないでしょうか？

Sub test()

　　'Sheet2の「A2」〜「K2」,「O2」〜「W2」,「L2」〜「N2」の最終行までコピー
　　Sheets("Sheet2").Select
　　Range("A2:K2, O2:W2, L2:N2").Select
　　Range(Selection, Selection.End(xlDown)).Select
　　Selection.copy
　　'Sheet1の「B2」, 「M2」, 「V2」に貼り付け
　　Sheets("Sheet1").Select
　　Range("B2, M2, V2").Select
　　ActiveSheet.paste

End Sub

どうかよろしくお願いします。
【78203】Re:このマクロを1つにまとめたいんですが
発言  β  - 16/5/25(水) 17:59 -
引用なし
パスワード
   ▼［名前なし］ さん：

エラーそのものは、たとえばシート上で複数セル領域をいくつか選択して
Ctrl/c とやると、エクセルから叱られますね。
これは仕様です。

それより、むりやり１つのロジックにまとめる必要はさらされないのでは？
たかだか３つのブロックのコピペですから。
ただ、コードの記述を少しすっきりさせたほうがいいですね。

以下は、貼り付け行数、領域によっては、下のほうの空白行部分もコピペされる
『手抜き』ですが
空白のところが空白になるだけなので。

それより現行のコード、

　　Range("A2:K2").Select
　　Range(Selection, Selection.End(xlDown)).Select
　　Selection.copy

たとえば A列以外でA列の行数より大きな行までデータがある部分があれば
その部分は貼り付け対象から漏れるということはお気づきですか？

Sub Sample()
　　Dim mx As Long
　　With Sheets("Sheet2")
　　　　mx = .UsedRange.Cells(.UsedRange.Cells.Count).Row
　　　　.Range("A2:K2").Resize(mx - 1).Copy Sheets("Sheet1").Range("B2")
　　　　.Range("O2:W2").Resize(mx - 1).Copy Sheets("Sheet1").Range("M2")
　　　　.Range("L2:N2").Resize(mx - 1).Copy Sheets("Sheet1").Range("V2")
　　End With
End Sub
【78204】Re:このマクロを1つにまとめたいんですが
発言  β  - 16/5/25(水) 22:09 -
引用なし
パスワード
   ▼［名前なし］ さん：

アップ後、説明文がへんになっていたので削除して、再掲します。

転記対象を２行目からにしていますね。
もし、１行目がタイトル行（すべての列で同じタイトルがない）とすれば
フィルターオプションが使えます。（書式などはコピーされず、値転記になりますが）

Sheet2 の A〜K のタイトルが SHeet1 の B〜L、Aheet2 の O〜Wのタイトルが Sheet1 のM〜U、
Sheet2 の L〜N のタイトルが SHeet1 の V〜X にあるという前提で。

コードが長いので改行していますが、実態は１行のコードで処理可能です。

Sub Sample2()
　　Sheets("Sheet2").Range("A1").CurrentRegion.AdvancedFilter Action:=xlFilterCopy, _
　　　　CopyToRange:=Sheets("Sheet1").Range("B1:X1"), Unique:=False
End Sub
【78208】Re:このマクロを1つにまとめたいんですが
お礼  ［名前なし］  - 16/5/26(木) 10:10 -
引用なし
パスワード
   説明と回答ありがとうございました。
無事マクロができました。
  新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム  
808 / 13645 ﾂﾘｰ ←次へ　｜　前へ→
ページ：  ┃  記事番号：
2610219
(SS)C-BOARD v3.8 is Free