Namning sheets after namnes in a column. [Closed]

Report
Posts
4
Registration date
Wednesday November 19, 2014
Status
Member
Last seen
November 19, 2014
-
venkat1926
Posts
1862
Registration date
Sunday June 14, 2009
Status
Contributor
Last seen
July 30, 2015
-
Searched for hours trying to solve this problem.., I have a list of students in my workbook and want to automaticly change the following sheets in my workbook to the diffrent stundentname I have i column A. I dont want to change the "main sheet" name only the following sheets. Anyone have a clue?


Posting a link to example file:

http://s000.tinyupload.com/index.php?file_id=35658383826475072526


Would be greatful!

1 reply

Posts
1862
Registration date
Sunday June 14, 2009
Status
Contributor
Last seen
July 30, 2015
790
I have removed some entreies outside main data. Better not to leave any cell blank as far as posible.so "name" is entered in A1
the sheet Main is like this

name 20141101 20141102 20141103 20141104 20141105 20141106
Adam Good qqqqq wwww eeee rrrr tttt
David better yyyyy uuuuuu iiiii oooo pppp
Julia good aaaa dddd fff ggggg hhhh
Ozzie bad kkkkk llllll zzzz xxxxxx ccccc


now try this macro (run only "test")

Function SheetExists(ShName As String) As Boolean
On Error Resume Next
SheetExists = Len(ActiveWorkbook.Sheets(ShName).Name)
End Function

Sub test()
Dim r As Range, nname As Range, cname As Range
Dim x As String, j As Integer
Application.ScreenUpdating = False
Application.DisplayAlerts = False
For j = Sheets.Count To 1 Step -1
If Worksheets(j).Name = "Main" Then GoTo nextj
Worksheets(j).Delete
nextj:
Next j


With Worksheets("main")
Set nname = Range(.Range("a2"), .Range("A2").End(xlDown))
Set r = .Range("A1").CurrentRegion
For Each cname In nname
x = cname
r.AutoFilter field:=1, Criteria1:=x
r.SpecialCells(xlCellTypeVisible).Copy
If Not SheetExists(x) Then
Worksheets.Add
ActiveSheet.Name = x
End If
With Worksheets(x)
.Range("A1").PasteSpecial
.Range("a1").CurrentRegion.Copy
'.Range("A1").Select
.Range("a5").PasteSpecial xlPasteValues, Transpose:=True
.Range("A1:A4").EntireRow.Delete
End With
.AutoFilterMode = False
Next cname
End With
Application.CutCopyMode = False
Application.ScreenUpdating = True
Application.DisplayAlerts = True
MsgBox "macro done"
End Sub