Create sheets from column B contents

[adamsm]

Hi anyone,

How could I write a macro code that would create sheets with the names of content in column B of the active sheet.

Any help on this would be kindly appreciated.

Thanks in advance.

 

[VoG]

Look here http://www.mrexcel.com/forum/showthread.php?t=396069

 

[adamsm]

Thanks for the reply but does the code in the thread copy the cell contents? What I'm trying to get is to create sheets with the name of the contents in column B from 4 to 38.

Any help on this would be kindly appreciated.

 

[VoG]

Try it with a copy of your sheet.

 

[adamsm]

Are you referring to the following code as I can see a bunch of codes?

Sub Lapta() Dim lastrow As Long, LastCol As Integer, i As Long, iStart As Long, iEnd As Long Dim ws As Worksheet Application.ScreenUpdating = False With ActiveSheet     lastrow = .Cells(Rows.Count, "A").End(xlUp).Row     LastCol = .Cells(1, Columns.Count).End(xlToLeft).Column     .Range(.Cells(2, 1), Cells(lastrow, LastCol)).Sort Key1:=Range("H2"), Order1:=xlAscending, _         Header:=xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom     iStart = 2     For i = 2 To lastrow         If .Range("H" & i).Value <> .Range("H" & i + 1).Value Then             iEnd = i             Sheets.Add after:=Sheets(Sheets.Count)             Set ws = ActiveSheet             On Error Resume Next             ws.Name = .Range("H" & iStart).Value             On Error GoTo 0             ws.Range(Cells(1, 1), Cells(1, LastCol)).Value = .Range(.Cells(1, 1), .Cells(1, LastCol)).Value             .Range(.Cells(iStart, 1), .Cells(iEnd, LastCol)).Copy Destination:=ws.Range("A2")             iStart = iEnd + 1         End If     Next i End With Application.CutCopyMode = False Application.ScreenUpdating = True End Sub</pre>

 

[adamsm]

The code is giving me debug message.