Macro to create multiple sheet, copy certain values and loop until end of row data

Hi, guys! I news help on this one. I would like to create a macro to copy sheet, name it based on cells from another sheet. I managed, through research, to execute it through looping. see code below:

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)
ThisWorkbook.Sheets(i + 1).Name = rngName.Value
Set rngName = rngName.Offset(1)
Loop
End Sub

It worked well, however, I also need to link or copy values corresponding to each name before it stops executing e.g. Name, Position from Sheet1. I would appreciate any help. Thanks!

Please add code tags to your code in accordance with forum rules.

Sorry for that I'm just a newbie here. Anyway, here is the code:

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)
ThisWorkbook.Sheets(i + 1).Name = rngName.Value
Set rngName = rngName.Offset(1)
Loop
End Sub

Originally Posted by jhoelski

I also need to link or copy values corresponding to each name before it stops executing e.g. Name, Position from Sheet1. I would apprecGhiate any help.

Could you clarify what you mean by this?

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

I need more to go on than that.

It should populate range A1:C1 on the new sheet with the name of the sheet (from Sheet1) and the two cells to the right of the name.

Assuming you still want to populate A1:C1 on each sheet

.Range("A1").resize(, 3).value = rngName.Offset(0, 1).resize(, 3).value

Got it,Rory! You've been a big help! One more request, what if aside from the autopopulate there is a bunch formula as well which are linked to the autopopulated sheets made by the macro, they are on absolute reference. Let me make it clear:

A. B. C. D. E.
1 name rank office =sheet2!b$4$ =sheet2!b$6$
2 ..
3 ..

The macro you gave me really saved me. I would appreciate it if you could help me further. Thanks again, Rory.

Let me summarize what the macro intends to do:
1. Create copy of sheet2 based on names on sheet1
2. Rename the sheets accordingly
3. Auto-populate certain values (name, etc.)
4. Create formula or absolute references to each named wsheet (on sheet1, adjacent to the name) before it proceeds with creating another worsheet with next name (loop until EOF)

thanks for all the help!

Try 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.Offset(0, 1).Resize(, 3).Value
            ' adjust formulas on sheet1
            rngName.Offset(0, 3).Resize(, 2).Replace what:="Sheet2", replacement:=.Name, _
                                                        lookat:=xlPart, MatchCase:=False
        End With
        Set rngName = rngName.Offset(1)
    Loop
End Sub

Would have saved time to have that to start with...

See attached.