ExcelのVBAで複数行を転記する方法について

質問

いつもお世話になります。YouTubeで変数を使わない複数行を纏めて転記する内容を見ました。”C10～H12セルの値をL10～Q12セルへ出力する"
<Range("L10:Q12")：Value=Range("C10:H12")：Value>　で一行で纏められる例題が出ていました。そこで私が作っている変数入りの複数行を一行で書く方法を教えてください。

””””私の作ったプログラムです”””””

Sub 領収証班別()
'出力行を設定する変数の定義
Dim CtrRow

'繰返し処理用の変数定義
Dim i

'------------------------------------------------------------------------------

'出力行の開始位置を設定
CtrRow = 2

'2行目から62行目まで繰り返す
For i = 2 To 62

'B(領収証の班別)に指定班名が合致しているか判定する
If Worksheets("領収証").Range("B" & i).Value = "南１班" Then

'Worksheets("領収証班別").Range("A" & CtrRow).Value = Worksheets("領収証").Range("A" & i).Value
'Worksheets("領収証班別").Range("B" & CtrRow).Value = Worksheets("領収証").Range("B" & i).Value
'Worksheets("領収証班別").Range("C" & CtrRow).Value = Worksheets("領収証").Range("C" & i).Value
'Worksheets("領収証班別").Range("D" & CtrRow).Value = Worksheets("領収証").Range("D" & i).Value
'Worksheets("領収証班別").Range("E" & CtrRow).Value = Worksheets("領収証").Range("E" & i).Value

'１行出力したため、出力行の位置を+1にする
CtrRow = CtrRow + 1

'判定処理の終了
End If

'繰り返し処理の終了
Next i

'------------------------------------------------------------------------------

'出力行の開始位置を設定
CtrRow = 24

'2行目から62行目まで繰り返す
For i = 2 To 62
　　　　：
　　　　：
次から次へと続きます。

と云うようなプログラムの中で
'Worksheets("領収証班別").Range("A" & CtrRow).Value = Worksheets("領収証").Range("A" & i).Value
'Worksheets("領収証班別").Range("B" & CtrRow).Value = Worksheets("領収証").Range("B" & i).Value
'Worksheets("領収証班別").Range("C" & CtrRow).Value = Worksheets("領収証").Range("C" & i).Value
'Worksheets("領収証班別").Range("D" & CtrRow).Value = Worksheets("領収証").Range("D" & i).Value
'Worksheets("領収証班別").Range("E" & CtrRow).Value = Worksheets("領収証").Range("E" & i).Value

この複数行をYouTubeの例題の様に一行に纏めて書く方法はありませんか？このプログラムも、よちよち歩きで作ったものです（初心者です）よろしくお願いいたします。

回答No.2

kkkkkm · ベストアンサー

回答No.1の訂正です。

If分があるのを見落としてました

Sub Test()
Dim i As Long
Dim CtrRow As Long

CtrRow = 2
For i = 2 To 62
If Worksheets("領収証").Range("B" & i).Value = "南１班" Then
Worksheets("領収証班別").Range("A" & CtrRow & ":E" & CtrRow).Value = Worksheets("領収証").Range("A" & i & ":E" & i).Value
CtrRow = CtrRow + 1
End If
Next

End Sub

もしくは

Sub Test2()
Dim i As Long
Dim CtrRow As Long
Dim Ws1 As Worksheet, ws2 As Worksheet

Set Ws1 = Worksheets("領収証班別")
Set ws2 = Worksheets("領収証")

CtrRow = 2
For i = 2 To 62
If Worksheets("領収証").Range("B" & i).Value = "南１班" Then
Ws1.Range(Ws1.Cells(CtrRow, "A"), Ws1.Cells(CtrRow, "E")).Value = ws2.Range(ws2.Cells(i, "A"), ws2.Cells(i, "E")).Value
CtrRow = CtrRow + 1
End If
Next

'中略

Set Ws1 = Nothing
Set ws2 = Nothing

End Sub

回答No.1

kkkkkm

次の
'出力行の開始位置を設定
CtrRow = 24

がなぜ24なのか分かりませんが

2行目から62行目までを代入でしたら
CtrRow = 2
i = 62

「領収証」の範囲A2からE62を「領収証班別」の範囲A2からE62に代入するとして

CtrRow = 2
i = 62
Worksheets("領収証班別").Range("A" & CtrRow & ":E" & i).Value = Worksheets("領収証").Range("A" & CtrRow & ":E" & i).Value

でいいのではないでしょうか。

以下のようにすると、以後シート名はWs1とかWs2とかで記載できます
Sub Test()
Dim i As Long
Dim CtrRow As Long
Dim Ws1 As Worksheet, ws2 As Worksheet

Set Ws1 = Worksheets("領収証班別")
Set ws2 = Worksheets("領収証")

CtrRow = 2
i = 62
Ws1.Range(Ws1.Cells(CtrRow, "A"), Ws1.Cells(i, "E")).Value = ws2.Range(ws2.Cells(CtrRow, "A"), ws2.Cells(i, "E")).Value

中略

Set Ws1 = Nothing
Set ws2 = Nothing
End Sub

お礼

返事が遅くなり申し訳ありません。 初めの回答文でうまくいきました。 本当にありがとうございました。 いろんなコマンドが有るものですね！ 大変勉強になりました。今後ともよろしくご教授お願いいたします。

Powered by GRATICA