指定セルをコピー

質問

A2~A5,D2~D5,G2~G5をコピーしJ~P列2~5行に値を貼付け続いて9~13行、16~20行もJ~P列に貼り付けたいのですが7~8,14~15行にはセル結合されているところもあります。VBAで下記コードを入力しましたがあまりにデータが多く何か良い方法VBAコードはありますか。(For~Nextなど使用すれば良いのでしょうか)
環境はoffice2013です。

Range("A2:A6").Select
Selection.Copy
Range("J2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("D2:D6").Select
Selection.Copy
Range("M2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
　Application.CutCopyMode = False

回答No.3

tsubu-yuki · ベストアンサー

追加の質問は受け付けない主義なのですが(笑)。
どうしても回答が長くなってしまうので(笑)。
んで、アレもコレもとキリが無くなるので。
質問のその前に、ご自身で色々試してみると良いですよ。
上書きしなければ元に戻せるんですから。
で、前の回答でのコードをよく読んで理解なさると良いですよ。
じゃないと先に進めませんから。

とりあえず。
> A,B列をJ,K列に
手作業でやる時ってどうされますか？
元の添付図で言うなら例えば
・Ａ２：Ｂ６を範囲指定して、コピー
・Ｊ２セルにフォーカスを移し、貼り付け
でできますよね。
これを「マクロの記録」してやると
　　Range("A2:B6").Select　
　　Selection.Copy
　　Range("J2").Select　　' 「どこのセルを先頭に」の指定も可能
　　ActiveSheet.Paste
　　Application.CutCopyMode = False
こう録れますね。（単純な貼り付けの例ですが。）
つまり前の回答の「可能性２」のソレを
　　Range("どこのセルから", "どこのセルまで").Copy
　　Cells(どこのセルを先頭に).PasteSpecial Paste:=xlPasteValues
に変えてやれば良さそうですね。
（というか、そのように書いたつもりでしたけどね。）
よって、
　　Range(Cells(i, j), Cells(i + 4, j + 1)).Copy
と打ち直してやれば良さそうです。
で、前の回答はそもそも「３行おき」ですのでそこは割愛。

> ”A2:G20”が１ブロックで次のブロックが５行空いた場合
日本語的に「読めばわかる」範囲の話のような気がします。
前の回答中の
　　For i = 2 To Cells(Rows.Count, 1).End(xlUp).Row Step 7　'行は７行おき
の意味をお考え下さい。
「行は」と注釈を入れている以上、
この変数「ｉ」を「行番号の素」として使うのだろう、と思いませんか？
上記は「２行目から初めて７行おきにデータが無くなるまで」の意味です。
これを
　２行目から２０行目まで⇒１９行　＋　５行おき
なのだから「２４行おき」に置き換えてやれば良いだけです。
つまり
　　For i = 2 To Cells(Rows.Count, 1).End(xlUp).Row Step 24
ですね。
範囲の指定は前述の通りなので「以下同文につき省略」。

あとはご自身で少し考えてみてくださいませ。

お礼

補足回答まで頂きありがとうございます。コード説明があり非常に助かりました。コード打込み変更により各処理ができ納得しました。大変ありがとうございました。

回答No.2

tsubu-yuki

「添付図を見る限り」だと私も同様に
　　Columns("A:G").Copy
　　Range("J1").PasteSpecial Paste:=xlPasteValues
　　'Application.CutCopyMode = False　　　'ココ、ほんとは不要
　　Range("K:L,N:O").ClearContents
Ａ～Ｇ列を一気にコピーしちゃって、
要らない列を消去（削除じゃないですよ）したらどうでしょ？なのですが。

問題は
> 7~8,14~15行にはセル結合されているところもあります
コレのおかげで「列全体消去できないよ」ってことでしょうか。
解消できる可能性がある力業を２通り。

可能性１）
　一回結合を解除、要らない列を消去して、
　転記元の列の「書式」をコピー・貼り付け
　　Columns("A:G").Copy
　　Range("J1").PasteSpecial Paste:=xlPasteValues 　　' 値を貼り付け
　　Columns("J:P").UnMerge　　' 結合解除
　　Range("K:L,N:O").ClearContents　　' 該当列消去
　　Columns("A:G").Copy　　' 再度コピー
　　Range("J1").PasteSpecial Paste:=xlPasteFormats　　' 書式を貼り付け
　　Application.CutCopyMode = False

可能性２）
　本当に必要なところだけコピー・貼り付け
　おっしゃる通り、簡単なのはFor～Next。
　　For i = 2 To Cells(Rows.Count, 1).End(xlUp).Row Step 7　'行は７行おき
　　　　For J = 1 To 7 Step 3　　' 列は３列おき
　　　　　　Range(Cells(i, j), Cells(i + 4, j)).Copy
　　　　　　Cells(i, j + 9).PasteSpecial Paste:=xlPasteValues
　　　　　　Application.CutCopyMode = False
　　　　Next j
　　Next i
　おそらく、コレでなんとか。

とりあえず、２通り。
コレら以外なら補足くださいませ。
ここに直接手打ちなので、スペースの位置とか違うかもです。

で、我流ですが、スッキリ書くアドバイス。
１）.Select　～～ Selection.
　必要な場面もありますが、ほとんどの場合は省略できます。
　例示だと
　　Range("D2:D6").Select　　' ココを選択して
　　Selection.Copy　　　　　 ' 選択されたところをコピー
　　　　　↓
　　Range("D2:D6").Copy　　'ココをコピー
　で通ります。
　カナ混じり日本語で見てもスッキリですね。
　必要・不要、色々お試しくださいませ。
２）要らないオプションは省略
　この例示の場合、貼り付けのオプションですね。
　初期値のままで良い場合や特にいじる必要が無いときは省略しちゃいます。
　良ければ、エクセル本体でとりあえず何かをコピーし、
　右クリック→形式を選択して貼り付け　でダイアログを出して、
　眺めながらご確認ください。
　・Paste　⇒　「貼り付け」の欄に対応　コレは省略しない方が良いかも。
　・Operation　⇒　「演算」の欄に対応　今回は必要ない・・かな。
　・SkipBlanks　⇒　「空白を無視する」のチェック　必要ないでしょう。
　・Transpose　⇒　「行列を入れ替える」　必要無いですな。
　ということで、必要ないところは省略します。
　　Range("M2").Select
　　Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, _
　　　　　　　　　　　　SkipBlanks:=False, Transpose:=False
　　　　　　　↓
　　Range("M2").PasteSpecial Paste:=xlPasteValues
　はぃ、スッキリしました。

補足

ありがとうございます。大変勉強になりました。可能性２の応用で頑張っています。ご質問なんですけど現状A列をJ列にそれから３列おきに貼付けですがA,B列をJ,K列にD,E列をM,N列に貼付けなど複数列を指定し列おきに貼付けできますか。また”A2:G20”が１ブロックで次のブロックが５行空いた場合ブロックの範囲指定も可能でしょうか。申し訳ありませんがご教授のほど宜しくお願いします。

回答No.1

imogasi

質問表現がコードと画像に頼りすぎて、下記でよい（十分）かどうか判断できない。
色んな場合の（表や値の）バラエティは、質問者にしかわからない。
画像例もあくまで簡略化しているかもしれず、すべての状況（セルの値などのセル的な配置状況）が説明されていない。文章で工夫するしかないだろうが、画像の方が完全と思っている質問者が多いので回答に困る。
下記回答なども、２１行より下の方に別の表があれば、直ちにアウトだが。
１ブロックだけで例にすると）（実際はもっと表があるのかもしれないが）
一旦コピーして、不要な列のデータを消す方法を考えた。これでよいか。
Sub test01()
With Sheet1
.Range("a2:G20").Copy Range("j2")
Range("k:K, L:L, N:N,O:O").Clear
End With
参考
離れた列を選択
http://www.tipsfound.com/vba/09004
End Sub

お礼

ありがとうございます。勉強になりました。