別のブックにシートをコピーするする際のインデックス有効範囲エラー）￥について

現在ブックがA.xlsmとB.xlsxがあります。
A.xlsmがマクロ実行用のエクセルです。

1) A.xlsmのCells(r,1)の文字列のブックB.xlsxを開く(B.xlsxには(r,2)のシート名が存在します)
2) A.xlsmのCells(r,2)の文字列の新しいブックC.xlsxを作成する
3) B.xlsxのシートをC.xlsxの同じシート名にコピーする

*具体的にわかりやすく申し上げれば
A.xlsm (r,1) 天気　(r,2)20190227
B.xlsxには20190227というシートが存在しており、(1,1)に晴れと記載されている
C.xlsxに晴れというブック名を付して、B.xlsxの同じシート名の晴れという内容を
コピーしてきたい

ということになります。ループになっているの少しわかりづらいのですが
上記を意図したコードが"インデックス有効範囲エラー"がでてしまうのですが
原因と解決方法を教えてください。

宜しくお願い申し上げます。

Sub fileOpenAndCreate()
  Dim fileName As String
  Dim r As Long
  Dim wb As Workbook
  Dim oldPath As String
  Dim newPath As String

  r = 2
  While Cells(r, 1) <> ""
    oldPath = "C:\Users\hoge\Desktop\TEST_SSE\record\" & Cells(r, 1).Value
    newPath = "C:\Users\hoge\Desktop\TEST_SSE\create\" & Cells(r, 2).Value

    Workbooks.Open (oldPath) '既にWBをOpenでも動作する仕様を確認
    Worksheets(Cells(r, 2).Value).Activate
    Set wb = Workbooks.Add
    wb.SaveAs (newPath)
    Worksheets(1).Name = Cells(r, 2).Value

    Workbooks(oldPath).Worksheets(Cells(r, 1).Value).Copy After:=Workbooks(newPath).Worksheets(Cells(r, 1).Value)


    r = r + 1
  Wend



End Sub

修正後のコード

Sub fileOpenAndCreate()
  Dim fileName As String
  Dim r As Long
  Dim oldPath As String
  Dim newPath As String

  Dim nWb As Workbook
  Dim oWb As Workbook
  Dim oWs As Worksheet
  Dim tWs As Worksheet
  Dim nWs As Worksheet


  Set tWs = Worksheets("実行シート")

  r = 2
  While Cells(r, 1) <> ""
    oldPath = "C:\Users\hoge\Desktop\TEST_SSE\record\" & tWs.Cells(r, 1).Value
    newPath = "C:\Users\hoge\Desktop\TEST_SSE\create\" & tWs.Cells(r, 2).Value

    'old------------
    Set oWb = Workbooks.Open(oldPath)  '既にWBをOpenでも動作する仕様を確認
    Set oWs = oWb.Worksheets(tWs.Cells(r, 2).Value)

    'new------------
    Set nWb = Workbooks.Add
    nWb.SaveAs (newPath)
    Set nWs = nWb.Worksheets(1)
    nWs.Name = tWs.Cells(r, 2).Value


    oWs.Copy After:=nWs(tWs.Cells(r, 2).Value)


    r = r + 1
  Wend



End Sub

再修正コード

Sub fileOpenAndCreate()
  Dim fileName As String
  Dim r As Long
  Dim oldPath As String
  Dim newPath As String

  Dim nWb As Workbook
  Dim oWb As Workbook
  Dim oWs As Worksheet
  Dim tWs As Worksheet
  Dim nWs As Worksheet
  Dim nWsTf As Worksheet


  Set tWs = Worksheets("実行シート")

  r = 2
  While tWs.Cells(r, 1) <> ""

    oldPath = "C:\Users\hoge\Desktop\TEST_SSE\record\" & tWs.Cells(r, 1).Value
    newPath = "C:\Users\hoge\Desktop\TEST_SSE\create\" & tWs.Cells(r, 2).Value


    Set oWb = Workbooks.Open(oldPath)  '既にWBをOpenでも動作する仕様を確認
    Set oWs = oWb.Worksheets(tWs.Cells(r, 2).Value)
    MsgBox "Doesnt work" & r '↑ここでインデックスエラー
    'new------------


    Set nWb = Workbooks.Add
    Set nWs = nWb.Worksheets("Sheet1")
    oWs.Copy After:=nWs

    Application.DisplayAlerts = False
    nWs.Delete
    Application.DisplayAlerts = True

    'new tf------------
    Set nWsTf = nWb.Worksheets(tWs.Cells(r, 2).Value)
    nWsTf.Cells.Font.Name = "ＭＳ Ｐゴシック"


    nWb.SaveAs (newPath)


    r = r + 1
  Wend



End Sub