loop to add worksheets then copy and paste values in list

Batemans

New Member
Joined
Sep 15, 2014
Messages
2
I have a workbook with names in column A of sheet1 -
LIST
Bob
Bill
Bill
Barry
Barry
John

I would like to create a new worksheet for each new name in the list;

Sub createwookbook()
Dim i As Integer
Dim ws As Worksheet
Set ws = Worksheets("Sheet1")
Frow = Cells(Rows.Count, 1).End(xlUp).Row
nextrow = 1
For i = 2 To Frow
If ws.Cells(i, 1) = ws.Cells(i, 1).Offset(-1, 0) Then

' do nothing

Else
Sheets.Add(After:=Sheets(Sheets.Count)).Name = ws.Cells(i, 1).Value
End If
Next i

' This creates the worksheets after sheet 1
' would then like to copy the name in the list to the corresponding worksheet name


For k = 2 To Frow
Select Case ws.Cells(k, 1).Value
Case "Bob"
ws.Cells(k, 1).Copy Destination:=Worksheets("Bob").Cells(nextrow, 1)
nextrow = nextrow + 1
Case "Bill"
ws.Cells(k, 1).Copy Destination:=Worksheets("Bill").Cells(nextrow, 1)
nextrow = nextrow + 1
End Select ' add select for each worksheet name
Next k
nextrow = 1
End Sub

This is close but doesn't quite work (nextrow needs to reset and start at A1 for each new worksheet. Your suggestions would be appreciated. Thanks.
 

Some videos you may like

Excel Facts

Test for Multiple Conditions in IF?
Use AND(test, test, test, test) or OR(test, test, test, ...) as the logical_test argument of IF.

Watch MrExcel Video

Forum statistics

Threads
1,108,506
Messages
5,523,305
Members
409,509
Latest member
CheekyDevil2386

This Week's Hot Topics

Top