I think you need something like this:
Sub copySheet2()
Dim rngName As Range
Dim i As Integer
Set rngName = ThisWorkbook.Sheets("Sheet1").Range("a1")
Do Until rngName.Value = ""
i = ThisWorkbook.Sheets.Count
Sheets("Sheet2").Copy After:=Sheets(i)
With ThisWorkbook.Sheets(i + 1)
   .Name = rngName.Value
   ' copy name and two adjacent cells to A1 on new sheet
   .Range("A1").resize(, 3).value = rngName.resize(, 3).value
End With
Set rngName = rngName.Offset(1)
Loop
End Sub