あるブックの任意の範囲を別のブックの指定した箇所にコピペする その3

今回は、前回配列や繰り返し構文などを使用して改修したマクロ
『同じフォルダ内にある「○○一覧.xlsx」の任意のシート内容をそれぞれ別のファイルに転記する』
をセルを参照して動くものに改修しました。

下図のようにセルB1以降に転記したいシートの名前を記入していきます。
「転記テスト2」ボタンに「tenki2」マクロが登録されています。

Sub tenki2()

'転記用のブック＆シート名の記入範囲をコピーする　
    Cells(1, 1).Activate
    ActiveSheet.UsedRange.Copy
    
'○○一覧を開いて転記用シートを挿入し、セルA1に貼り付けする
    Workbooks.Open ThisWorkbook.Path & "\◯◯一覧.xlsx"
    Worksheets.Add Before:=Sheets(1)
    ActiveSheet.Name = "転記用"
    Cells(1, 1).Activate
    ActiveSheet.Paste
    
'変数の宣言
    Dim i As Long
    Dim maxSheetCount As Long
    Dim sheetName As String
    
'参照するセルの一番右の位置を確認する
    maxSheetCount = Cells(1, Columns.Count).End(xlToLeft).Column
    
'転記用シートからシート名の入っているセルを指定する
    For i = 2 To maxSheetCount
        Worksheets("転記用").Activate
        sheetName = Cells(1, i)
          
'シート内容を転記する
        Worksheets("転記用").Activate
        Worksheets(sheetName).Activate
        Cells(1, 1).Activate
        Worksheets(sheetName).UsedRange.Copy
        Workbooks.Open ThisWorkbook.Path & "\" & sheetName & "YYMMDD.xlsx"
        Worksheets("データ").Range("A1").Select
        ActiveSheet.Paste
        Range("A1").Select
        ActiveWorkbook.Save
        ActiveWindow.Close
   Next i
    
'○○一覧を保存せずに閉じる
    Application.DisplayAlerts = False
    ActiveWindow.Close
    Application.DisplayAlerts = True
End Sub

セルの値を参照させるのにわざわざ新しいシートを作成してコピペしたのは遠回りな気もしますが・・・。
他の案はことごとくエラーになってしまいました。
でも、なんとか参照したいシートの数や名前が変わっても対応できる感じになってきました！
次回はメッセージボックスを使ってみたいと思います。