excelマクロ 一行飛ばしのセルをコピーして別シートに貼りつける

excelマクロの勉強中です。

一行飛ばしのセルをコピーして、別シートに貼りつける（※貼りつける際はセルを詰める）マクロの書き方を教えてください。

よろしくお願い致します。

No.1 ベストアンサー 回答者： tom04 回答日時： 2018/02/06 14:11

こんにちは！

色々やり方はありますが、一例です。
画像通りになるようにしています。
標準モジュールにしてください。

Sub Sample1()
Dim i As Long, myRng As Range
With Worksheets("Sheet1")
For i = 3 To .Cells(Rows.Count, "B").End(xlUp).Row Step 2
If myRng Is Nothing Then
Set myRng = .Cells(i, "B").Resize(, 2)
Else
Set myRng = Union(myRng, .Cells(i, "B").Resize(, 2))
End If
Next i
myRng.Copy Worksheets("Sheet2").Range("B4")
End With
End Sub

こんな感じで画像のような配置になります。m(_ _)m

この回答へのお礼

無事に処理が出来ました！！
勉強になりました。ありがとうございます。

お礼日時：2018/02/08 09:26

No.3 回答者： WindFaller 回答日時： 2018/02/06 18:30

私が書いたものは、VBAを学ぶというには該当しない、単なるテクニックです。

しかし、「テクニックはテクニックに溺れることがある」と言います。
この程度ならよいのですが、複雑になる可能性がある場合は、凝ったテクニックは使わない方がよいです。可読性が落ちてしまいます。そんな時に補うには、VBAのスニペット（ツールが必要・例：MZ-Tools)を利用すると良いです。

ジャンプ機能を使ってコピー&ペースト

'//
Sub ValuedCopy_Paste1()
　Dim Rng As Range
　Dim scrSh As Worksheet: Set scrSh = Worksheets("Sheet1")　'元
　Dim dstSh As Worksheet: Set dstSh = Worksheets("Sheet2")　'先
　With scrSh
　　　Set Rng = .Range("B3", .Cells(Rows.Count, "B").End(xlUp).Offset(, 1))
　　　Rng.SpecialCells(xlCellTypeConstants, xlNumbers + xlTextValues).Copy dstSh.Range("B4")
　End With
End Sub

この回答へのお礼

回答ありがとうございます。

お礼日時：2018/02/08 09:32

No.2 回答者： fujillin 回答日時： 2018/02/06 15:03

こんにちは

お勉強中とのことですので、別の例です。

単純に1行ずつ順にコピーしてゆくプリミティブな方法です。
対象が少ないうちはほとんど差はありませんが、量が多くなると、多分、No1様の方法の方が処理速度は速いと想像します。

Sub Sample()
Dim sorc As Range, dest As Range

Set sorc = Worksheets("Sheet1").Rows(3) '←コピー元の最初の行
Set dest = Worksheets("Sheet2").Rows(4) '←コピー先の最初の行

While sorc.Row <= sorc.Worksheet.Cells(Rows.Count, 2).End(xlUp).Row
　sorc.Copy Destination:=dest
　Set sorc = sorc.Offset(2)
　Set dest = dest.Offset(1)
Wend

End Sub

この回答へのお礼

ご回答ありがとうございます！
勉強になります！

お礼日時：2018/02/08 09:31