Namning sheets after namnes in a column.
Closed
glukos
Posts
2
Registration date
Wednesday 19 November 2014
Status
Member
Last seen
19 November 2014
-
19 Nov 2014 à 11:23
venkat1926 Posts 1863 Registration date Sunday 14 June 2009 Status Contributor Last seen 7 August 2021 - 20 Nov 2014 à 00:21
venkat1926 Posts 1863 Registration date Sunday 14 June 2009 Status Contributor Last seen 7 August 2021 - 20 Nov 2014 à 00:21
Related:
- Xxxxxxccccc
- Google sheets download - Download - Spreadsheets
- How to delete a column in word - Guide
- Excel column number - Guide
- Google sheets right to left - Guide
- Sheets vba - Guide
1 response
venkat1926
Posts
1863
Registration date
Sunday 14 June 2009
Status
Contributor
Last seen
7 August 2021
811
20 Nov 2014 à 00:21
20 Nov 2014 à 00:21
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")
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
