エクセルVBA/抽出・貼付け

質問

下記を行いたいのですが、どのようなコードになるのでしょうか？
シート001（入力用）
(1)A1～A50、B1～B50、C1～C50、D1～D50
　に数値、E1～E50に文字列
(2)F1～F50、G1～G50、H1～H50、I1～I50
　に数値、J1～J50に文字列
※空白行混在

シート002（計算用）
シート001に作ったコマンドボタン：クリックにより、
シート002を表示させ、A1～E100に、
シート(1)のA1～E50とF1～J50の空白行以外を連続して
反映させたい。並べ替え用など別シートを用いずに、
VBAコード内で処理したい。

回答No.2

shishishishi · ベストアンサー

> 値のみを貼り付けたいのですが。

それでしたらこれでどうですか。

Sub test()
Dim S1 As Worksheet
Dim S2 As Worksheet

Set S1 = Sheets("001")
Set S2 = Sheets("002")

For i = 1 To 100
If i < 51 Then
If S1.Cells(i, 1) <> "" Then
n = n + 1
S2.Range(S2.Cells(n, 1), S2.Cells(n, 5)).Value _
= S1.Range(S1.Cells(i, 1), S1.Cells(i, 5)).Value
End If
Else
If S1.Cells(i - 50, 6) <> "" Then
n = n + 1
S2.Range(S2.Cells(n, 1), S2.Cells(n, 5)).Value _
= S1.Range(S1.Cells(i - 50, 6), S1.Cells(i - 50, 10)).Value
End If
End If
Next

End Sub

お礼

うまくいきました。ありがとうございます。

回答No.1

shishishishi

Sheets("001")は表が横に２つ並んでて、Sheets("002")では、それを縦に並べるって感じですね？

こんな感じでどうでしょうか。

Sub test()
Dim S1 As Worksheet
Dim S2 As Worksheet

Set S1 = Sheets("001")
Set S2 = Sheets("002")

For i = 1 To 100
If i < 51 Then
If S1.Cells(i, 1) <> "" Then
n = n + 1
S1.Range(S1.Cells(i, 1), S1.Cells(i, 5)).Copy S2.Range(S2.Cells(n, 1), S2.Cells(n, 5))
End If
Else
If S1.Cells(i - 50, 6) <> "" Then
n = n + 1
S1.Range(S1.Cells(i - 50, 6), S1.Cells(i - 50, 10)).Copy S2.Range(S2.Cells(n, 1), S2.Cells(n, 5))
End If
End If
Next

End Sub

お礼

ありがとうございます。拙い文書を読み取っていただいて感謝しております。まさに、そのとおりです。質問に漏れがありまして、お手数ですが、再度教えてください。
値のみを貼り付けたいのですが。