繰り返し処理のマクロ

質問

下記のマクロをご教示いただけるでしょうか。

①シートAのアクティブセルをコピーし、シートBのE1セルにペースト
②マクロ「結果反映」を実行
➂シートAのアクティブセルを１行下に移動

①から➂をアクティブセル＝空白セルになるまで繰り返し

回答No.2

kkkkkm · ベストアンサー

> シートBがアクティブシートになっている状態でマクロ「結果反映」を実行する

最初にシートAの ActiveCellのRangeをSetし、以降はシートBをアクティブにしたままに変更しています。

Sub Test()
Dim Ws1 As Worksheet, Ws2 As Worksheet
Dim FCell As Range
Dim LastRow As Long, i As Long

Set Ws1 = Sheets("シートA")
Set Ws2 = Sheets("シートB")

Ws1.Activate
Set FCell = ActiveCell
Ws2.Activate

''未入力セル選択時に中止する場合は以下を有効に
'If FCell.Value = "" Then
' MsgBox "未入力セルが選択されています", vbInformation
' Exit Sub
'End If
'
LastRow = Ws1.Cells(Rows.Count, FCell.Column).End(xlUp).Row

For i = 0 To LastRow - FCell.Row
Ws2.Range("E1").Value = FCell.Offset(i, 0).Value
Call 結果反映
Next
Set FCell = Nothing
Set Ws1 = Nothing
Set Ws2 = Nothing
End Sub

結果反映の時だけシートBをアクティブにしてそれ以外はシートAをアクティにしたい場合は

Ws1.Activate
Set FCell = ActiveCell
Ws2.Activate
を
Ws1.Activate
Set FCell = ActiveCell

にしてCall 結果反映の部分を以下にしてください。

Ws2.Activate
Call 結果反映
Ws1.Activate

お礼

バッチリです！　いつもありがとうございます。

Powered by GRATICA

回答No.1

kkkkkm

> アクティブセル＝空白セルになるまで繰り返し

これの最後のとらえかたで二通り考えてみました。
一定のセルではなくアクティブセルということなのでSheets("シートA")で選択されている ActiveCellを対象に進みます。

'選択している列の利用している最終行まで実行

Sub Test()
Dim Ws1 As Worksheet, Ws2 As Worksheet
Dim LastRow As Long, i As Long

Set Ws1 = Sheets("シートA")
Set Ws2 = Sheets("シートB")

Ws1.Activate

'未入力セル選択時に中止する場合は以下を有効に
'If ActiveCell.Value = "" Then
' MsgBox "未入力セルが選択されています", vbInformation
' Exit Sub
'End If
'
LastRow = Ws1.Cells(Rows.Count, ActiveCell.Column).End(xlUp).Row

For i = 0 To LastRow - ActiveCell.Row
Ws2.Range("E1").Value = ActiveCell.Offset(i, 0).Value
Call 結果反映
Next
Set Ws1 = Nothing
Set Ws2 = Nothing
End Sub

'選択している列の利用している最終行までに空白セルがあればそこでストップ

Sub Test2()
Dim Ws1 As Worksheet, Ws2 As Worksheet
Dim LastRow As Long, i As Long

Set Ws1 = Sheets("シートA")
Set Ws2 = Sheets("シートB")

Ws1.Activate

'こちらは未入力セル選択時には何も起こらないのでメッセージを出します
If ActiveCell.Value = "" Then
MsgBox "未入力セルが選択されています", vbInformation
Exit Sub
End If

i = 0
Do While ActiveCell.Offset(i, 0).Value <> ""
Ws2.Range("E1").Value = ActiveCell.Offset(i, 0).Value
Call 結果反映
i = i + 1
Loop
Set Ws1 = Nothing
Set Ws2 = Nothing
End Sub

補足

ご回答ありがとうございます。仕様変更で申し訳ないのですが、②でシートBがアクティブシートになっている状態でマクロ「結果反映」を実行するにはどのように記述を変えれば良いでしょうか？
（この記述ではマクロ「結果反映」が正しく動作しないので、シートBがアクティブシートではない状態で実行しているのが原因ではないかと考えました。マクロ「結果反映」単体では正しく動作します）