【Excel】エクセルで1行おきにコピー貼り付け（1つ飛ばし、1行ごとにコピペ）する方法

Sub CopyAlternateRows()
    Dim lastRow As Long
    Dim i As Long, j As Long
    
    lastRow = Sheets("Sheet1").Cells(Rows.Count, 1).End(xlUp).Row
    
    For i = 2 To lastRow Step 2
        j = j + 1
        Sheets("Sheet2").Cells(j, 1) = Sheets("Sheet1").Cells(i, 1)
        Sheets("Sheet2").Cells(j, 2) = Sheets("Sheet1").Cells(i, 2)
    Next i
End Sub

このマクロの処理は以下の通りです。

Alt+F8でマクロ選択画面を開きCopyAlternateRows関数を実行すると処理完了です！

エクセルで1行ごとにコピーする方法【数式：元が連続で2行目から最終行までコピーし、別シートに1つ飛ばしで貼り付け】

次は、元が連続したデータをコピー先で1行おきに飛ばして貼り付ける方法です。

元データは上と同じものを使用しています。

これを、1行飛ばしで以下のように貼り付けます。

このためには、以下の数式を使います。

=IF(MOD(ROW()-1,2)=0,OFFSET(Sheet1!$A$1,INT((ROW()-1)/2)+1,COLUMN()-1),"")  

この数式の意味は次の通りです:

この数式をコピーして必要な行数分貼り付ければ、1行飛ばしでデータが並びます。

VBA（マクロ）の場合

VBAマクロでも同様の処理ができます。Alt+F11でVBE画面を開いて以下をコピペしましょう。

Sub CopyToAlternateRows()
    Dim lastRow As Long
    Dim i As Long, j As Long
    
    lastRow = Sheets("Sheet1").Cells(Rows.Count, 1).End(xlUp).Row
    
    j = 1
    For i = 2 To lastRow
        Sheets("Sheet2").Cells(j, 1) = Sheets("Sheet1").Cells(i, 1)
        Sheets("Sheet2").Cells(j, 2) = Sheets("Sheet1").Cells(i, 2)
        j = j + 2
    Next i
End Sub