OR:
Sub abjacz()
Dim rcell As Range, x As String, y As String
y = InputBox("Please Enter The Column: (Letter Designation)")
With Sheets("page")
.Columns(y).Replace " ", "", xlPart
For Each rcell In .Range(y & "3:" & y & .Range(y & Rows.Count).End(3).Row)
If rcell.Value <> rcell.Offset(-1).Value Then
x = rcell.Value
Sheets.Add after:=Sheets(Sheets.Count)
ActiveSheet.name = x
Sheets(x).Rows(1).Value = Sheets("page").Rows(1).Value
.Range(y & "1:" & y & .Range(y & Rows.Count).End(3).Row).AutoFilter 1, x
.Range(y & "2:" & y & .Range(y & Rows.Count).End(3).Row).SpecialCells(12).EntireRow.Copy Sheets(x).Range("A" & Rows.Count).End(3)(2)
.AutoFilterMode = False
End If
Next rcell
End With
End Sub
Bookmarks