【Q&A】連続したセルデータを１行づつ離して貼り付け #Excel #VBA

当サイトのコンタクトフォームへVBAのループについてお困りとのご質問が寄せられたので、せっかくなので直接返信ではなく、記事のかたちで回答したいと思います(・∀・)

質問者の方もご了承いただければ幸いですm(_ _)m

コンタクトフォームへ寄せられたご質問

タイトル
連続したセルデータを１行づつ離して貼り付け
本文
お世話様になります　VBA初心者です。
標記のようにしたく
Sub 行飛び貼り付け()
Dim i
Dim h
For i = 200 To 210
Range(Cells(i, 2), Cell(i,30)).Copy
For h = 300 To 320 Step 2
Cells(h, 2).PasteSpecial Paste:=xlPasteValues
Next
Next
End Sub
としましたが連続したセルデータを読み込んでくれません ※同じデータを1行づつ離して貼り付けてはくれます。どのようにしたらうまく行くのかご教示頂けないでしょうか、よろしくお願いします

回答

まず、質問者の方が記述したVBAの検証から開始しました。

サンプルデータ

頂いたVBAのコードを見る限り、200～210行目のB～AD列を300行目以降に1行飛ばしでコピペしていきたいのだと察しています。

そこで、取り急ぎコピー元のデータとしてA～AD列の1～210行目まで自セルの番地を各セルの値にして用意してみました。

コード検証

ここで質問者の方のVBAコードを起動してみます。

ちなみに、頂いたコードの5行目の2つ目のCellsプロパティの”s”が記述漏れがありましたので追記してます。
また、見やすいようにインデントも行ったものが以下のコードですね(*^-^*)

Sub 行飛び貼り付け_Before()

    Dim i
    Dim h
    For i = 200 To 210
        Range(Cells(i, 2), Cells(i, 30)).Copy
        For h = 300 To 320 Step 2
            Cells(h, 2).PasteSpecial Paste:=xlPasteValues
        Next
    Next
    
End Sub

Sub 行飛び貼り付け_Before()

Dim i

Dim h

For i = 200 To 210

Range(Cells(i, 2), Cells(i, 30)).Copy

For h = 300 To 320 Step 2

Cells(h, 2).PasteSpecial Paste:=xlPasteValues

End Sub

結果は以下の通りです。

ご覧の通り、300・302・304・306・308・310・312・314・316・318・320行目のすべてに210行目のデータが入っていますね。

これはなぜかというと、上記の行すべてに、変数”i”で格納している200～210行目が順番にコピペするようなコードになってしまっているからです。

たとえば、一番最初の変数”i”が”200″の場合、300行目にコピペしただけで終わらず、302～320行目に1行飛ばしで200行目の値がコピペされてしまっているということですね。

なので、変数”i”の数だけ300～320行目の同じ箇所に上書きでコピペを繰り返しており、変数”i”の最後の値となる”210″が最後にコピペを行ったものになるため、マクロの終了結果が上図のようにすべて210行目のデータになっているわけです。

コード改善案

先ほどの結果からFor Nextステートメントのネスト（入れ子）は止めて、B列の最終行に応じてIfステートメントで条件分岐させる方向で改修してみました。

内容は以下の通りです。

Sub 行飛び貼り付け_After()
    Dim i, LastRow As Long
    Const h As Long = 300  '貼り付けの開始行（固定値のため定数指定）
    
    Application.ScreenUpdating = False '画面描画を停止

    For i = 200 To 210
    
        'B列の最終行を取得
        LastRow = ActiveSheet.Cells(Rows.Count, 2).End(xlUp).Row
        
        '最終行が210行目なら300行目に貼り付け
        If LastRow = 210 Then
            Range(Cells(i, 2), Cells(i, 30)).Copy
            Cells(h, 2).PasteSpecial Paste:=xlPasteValues
        Else
        '最終行が210行目以外なら最終行の2行下に貼り付け
            Range(Cells(i, 2), Cells(i, 30)).Copy
            Cells(LastRow + 2, 2).PasteSpecial Paste:=xlPasteValues
        End If
    
    Next i
    
    Application.CutCopyMode = False 'カットコピーモードを解除
        
    Application.ScreenUpdating = True '画面描画を再開
    
End Sub

Sub 行飛び貼り付け_After()

Dim i, LastRow As Long

Const h As Long = 300 '貼り付けの開始行（固定値のため定数指定）

Application.ScreenUpdating = False '画面描画を停止

For i = 200 To 210

'B列の最終行を取得

LastRow = ActiveSheet.Cells(Rows.Count, 2).End(xlUp).Row

'最終行が210行目なら300行目に貼り付け

If LastRow = 210 Then

Range(Cells(i, 2), Cells(i, 30)).Copy

Cells(h, 2).PasteSpecial Paste:=xlPasteValues

Else

'最終行が210行目以外なら最終行の2行下に貼り付け

Range(Cells(i, 2), Cells(i, 30)).Copy

Cells(LastRow + 2, 2).PasteSpecial Paste:=xlPasteValues

End If

Next i

Application.CutCopyMode = False 'カットコピーモードを解除

Application.ScreenUpdating = True '画面描画を再開

End Sub

コードの高速化のため「Application.ScreenUpdating」を5・26行目に、そして、コピーモードを解除するために「Application.CutCopyMode = False」を24行目に挿入していますが、ご質問内容に直接関係ないので、いったん無視してください。

では、本題のところの解説に移っていきます。

変数・定数

    Dim i, LastRow As Long
    Const h As Long = 300  '貼り付けの開始行（固定値のため定数指定）

2 3	Dim i, LastRow As Long Const h As Long = 300 '貼り付けの開始行（固定値のため定数指定）

まず、2行目の変数の追加をしているのが、“LastRow”です。こちらは、「最終行」を特定するための変数です。
なお、変数”i”と”LastRow”は桁数の多い整数に対応するように変数のデータ型は「Long」を指定しています。こちらは特に指定しなくてもOKです。

次に、3行目は変数”h”であったものを定数に変更しています。
また、貼り付け先の開始位置となる行は300行目で固定するために定数にしました。
定数が分かりにくければ、変数で”300″を別途指定しても、結果は一緒です。

For Nextステートメントのカウンタ変数

    For i = 200 To 210

7	For i = 200 To 210

7行目からがFor Nextステートメントによるループが開始となります。
こちらは貼り付け元の行数となる200～210行目を指定するのは変更していませんね。

変数”LastRow”

        LastRow = ActiveSheet.Cells(Rows.Count, 2).End(xlUp).Row

10	LastRow = ActiveSheet.Cells(Rows.Count, 2).End(xlUp).Row

次に、10行目に変数”LastRow”にB列の最終行を格納します。
大事なポイントとしては、必ずこの最終行の取得はFor Nextステートメントの中に入れてください。理由としては、変数”i”の値が変わるごとに都度最終行を取得させたいからです。

なお、最終行の取得については、下記記事を元に詳細を確認してくださいね(*^-^*)

【Excel VBA】ワークシート内のデータがある最終行番号を取得する方法 | Excelを制する者は人生を制す　～No Excel No Life～

もし、B列の320行目より下の行に何かしらの値がある場合はうまく条件分岐しなくなるため、その場合は「Rows.Count」の部分を問題ない行数を指定するなどして、初回のループ時に210行目を取得できるようにしてくださいね。

Ifステートメント

        If LastRow = 210 Then

13	If LastRow = 210 Then

続いて、13行目のIfステートメントで最終行の値によって処理を分岐させます。
分岐の条件は変数”LastRow”の値が”210″とイコールか否かです。

真の場合

            Range(Cells(i, 2), Cells(i, 30)).Copy
            Cells(h, 2).PasteSpecial Paste:=xlPasteValues

Range(Cells(i, 2), Cells(i, 30)).Copy

Cells(h, 2).PasteSpecial Paste:=xlPasteValues

イコールの場合の処理が14・15行目に該当します。
「イコールの場合」は変数”i”の最初の値となる”200″のみです。
つまり、ループの初回のみi行のB～AD列をコピーし、B300セルへ値貼り付けを行うわけですね。

偽の場合

            Range(Cells(i, 2), Cells(i, 30)).Copy
            Cells(LastRow + 2, 2).PasteSpecial Paste:=xlPasteValues

Range(Cells(i, 2), Cells(i, 30)).Copy

Cells(LastRow + 2, 2).PasteSpecial Paste:=xlPasteValues

そして、「イコールでない場合」の処理が18・19行目に該当します。

上記のループの初回の貼り付けが行われたことで、2回目のループの時点で変数”LastRow”に格納されるB列の最終行が”300″になりますね。
そうすると、コピー自体の処理は「イコールの場合」と同じくi行のB～AD列をコピーしますが、貼り付け場所を変数”LastRow”の2行下に指定する部分が異なりますね。
2回目のループであれば、変数”LastRow”が”300″なので、2行下のB列のB302セルへ値貼り付けを行います。

3回目以降は、B304セル以降へ1行飛ばしで貼り付け先のセルが下方向へずれていきますよ。