Auto insert worksheet based on data from a cell range

[Xaos]

Hello all.

I'm looking to add new worksheets to the end of my workbook based on names from a range of cells.

For example:

OLD.JPG

becomes:

NEW.JPG

any help appreciated.

[Solus Rankin]

Duplicate post

[Solus Rankin]

Sub YouGetYourOwnSpot()

Dim l As Long
Dim lRow As Long
Dim ws1 As Worksheet
Dim ws2 As Worksheet

Set ws1 = ActiveSheet
lRow = Range("D" & Rows.Count).End(xlUp).Row

For l = 2 To lRow
    If ws1.Range("D" & l).Value <> "" Then
        Set ws2 = ActiveWorkbook.Sheets.Add(, After:=Sheets(Worksheets.Count))
        ws2.Name = ws1.Range("D" & l).Value
    End If
Next l

ws1.Activate

End Sub

[Xaos]

Awesome! Thank you this works perfectly. I appreciate your help.