VBA 特定のシートに同じ処理をさせたい

質問

下記のプログラムはランキングをHTML化にしたものです。
シート名3つ
・スペシャルクラス
・オープンクラス
・ビギナークラス
で入力し、同時に処理したいと考えています。
https://excel-ubara.com/excelvba1r/EXCELVBA520.html

分からないことはHTML名で保存する処理です。
保存するファイル名　Sample.html
それを同時に保存する方法を教えてください。
スペシャルクラス.html
オープンクラス.html
ビギナークラス.html

Sub convertHTML()
Dim ws As Worksheet
Dim i As Long
Dim LineData As String
Dim Target As String

Target = ActiveWorkbook.Path & "\Sample.html"
Set ws = ThisWorkbook.Worksheets(1)
i = 1
With CreateObject("ADODB.Stream")
.Charset = "UTF-8"
.Open
LineData = ""
Do While Not (ws.Cells(i, 1).Value = "" And ws.Cells(i, 2).Value = "" And ws.Cells(i, 3).Value = "")
LineData = LineData & "<div>" & ws.Cells(i, 1).Value & "</div>" & vbCrLf
LineData = LineData & "<p>" & ws.Cells(i, 2).Value & "</p>" & vbCrLf
LineData = LineData & "<span>" & ws.Cells(i, 3).Value & "</span>" & vbCrLf
i = i + 1
Loop
.WriteText LineData, 1
.SaveToFile Target, 2
.Close
End With
MsgBox Target & "に書き出しました"
End Sub

回答No.1

nishi6 · ベストアンサー

こんな感じでしょうか。テスト未実施です。

Sub Sample1()
　Dim shtNM As Variant
　shtNM = Split("スペシャルクラス,オープンクラス,ビギナークラス", ",")
　Dim F As Integer

　Dim ws As Worksheet
　Dim i As Long
　Dim LineData As String
　Dim Target As String

　For F = 0 To UBound(shtNM)
　　Target = ActiveWorkbook.Path & "\" & shtNM(F) & ".html"
　　Set ws = ThisWorkbook.Worksheets(shtNM(F))
　　ws.Activate
　　i = 1
　　With CreateObject("ADODB.Stream")
　　　.Charset = "UTF-8"
　　　.Open
　　　LineData = ""
　　　Do While Not (ws.Cells(i, 1).Value = "" And ws.Cells(i, 2).Value = "" And ws.Cells(i, 3).Value = "")
　　　　LineData = LineData & "<div>" & ws.Cells(i, 1).Value & "</div>" & vbCrLf
　　　　LineData = LineData & "<p>" & ws.Cells(i, 2).Value & "</p>" & vbCrLf
　　　　LineData = LineData & "<span>" & ws.Cells(i, 3).Value & "</span>" & vbCrLf
　　　　i = i + 1
　　　Loop
　　　.WriteText LineData, 1
　　　.SaveToFile Target, 2
　　　.Close
　　End With
　 'MsgBox Target & "に書き出しました"
　Next
End Sub

お礼

コメントをありがとうございます。
うまくできました。