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
Bookmarks