VBAの繰り返し処理表記と複数の処置条件について

いつもお世話になっております。
https://oshiete.goo.ne.jp/qa/13311940.html
の質問をした者です。
この度、上記のVBAに繰り返し処理と【VAIO】の条件に加え【HP】も条件とする場合、
どの様な構文になるのかのご教示をいただきたく質問させていただきました。

Sub Test()
Dim rr As Range
Dim rf As Range

Set rr = Range("B3", Cells(Rows.Count, "B").End(xlUp))
Set rf = rr.Find("VAIO", , xlValues, xlWhole)

If rf Is Nothing Then
MsgBox "検索値は見つかりませんでした"
Set rr = Nothing
Exit Sub
End If

Range("C1:F1").Copy
rf.Offset(, 6).PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False

Set rr = Nothing
Set rf = Nothing

End Sub

どうぞよろしくお願いいたします。

No.1 ベストアンサー 回答者： めぐみん_ 回答日時： 2023/01/23 20:48

こんな感じですかな？

Sub megu_2()
Dim rr As Range
Dim rf As Range
Dim sn, F_add As String

Set rr = Range("B3", Cells(Rows.Count, "B").End(xlUp))

For Each sn In Array("VAIO", "HsP", "HP")

Set rf = rr.Find(sn, , xlValues, xlWhole)

If rf Is Nothing Then
MsgBox "検索値は見つかりませんでした ：" & sn
Else
F_add = rf.Address
End If

Do

If rf Is Nothing Then Exit Do

Range("C1:F1").Copy
rf.Offset(, 6).PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False

Set rf = rr.FindNext(rf)

Loop Until rf.Address = F_add

Set rf = Nothing

Next

Set rr = Nothing

End Sub

この回答へのお礼

めぐみん様、先日に引き続きVBAの構築ありがとうございます。
こちらのVBAで理想の処理が実現できました！
ありがとうございました。

お礼日時：2023/01/24 12:54