Namning sheets after namnes in a column.
Closed
glukos
Posts
4
Registration date
Wednesday November 19, 2014
Status
Member
Last seen
November 19, 2014
-
Nov 19, 2014 at 11:23 AM
venkat1926 Posts 1863 Registration date Sunday June 14, 2009 Status Contributor Last seen August 7, 2021 - Nov 20, 2014 at 12:21 AM
venkat1926 Posts 1863 Registration date Sunday June 14, 2009 Status Contributor Last seen August 7, 2021 - Nov 20, 2014 at 12:21 AM
Related:
- Namning sheets after namnes in a column.
- Google sheets rtl - Guide
- Excel copy column from one sheet to another automatically - Guide
- Mark sheet in excel - Guide
- How to open excel sheet in notepad++ - Guide
- How to take screenshot in excel sheet - Guide
1 response
venkat1926
Posts
1863
Registration date
Sunday June 14, 2009
Status
Contributor
Last seen
August 7, 2021
811
Nov 20, 2014 at 12:21 AM
Nov 20, 2014 at 12:21 AM
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
