Hello
I want to create worksheets based on what information is contained in a column. I am using the code below which is working ok.
Public Sub Sort_To_Tabs()
Const TEST_COLUMN As String = "D" '<=== change to suit
Dim i As Long
Dim iLastRow As Long
Dim iRow As Long
Dim sh As Worksheet
With ActiveSheet
iLastRow = .Cells(.Rows.Count, TEST_COLUMN).End(xlUp).Row
For i = 2 To iLastRow
Set sh = Nothing
On Error Resume Next
Set sh = Worksheets(.Cells(i, TEST_COLUMN).Value)
On Error GoTo 0
If sh Is Nothing Then
Set sh = Worksheets.Add
sh.Name = .Cells(i, TEST_COLUMN).Value
.Rows(1).Copy sh.Range("A1")
iRow = 2
Else
iRow = sh.Cells(sh.Rows.Count, TEST_COLUMN).End(xlUp).Row
iRow = iRow + 1
End If
.Rows(i).Copy sh.Range("A" & iRow)
Next i
.Activate
End With
End Sub
The only problem is that everytime I change the column, I have to go into the VBA editor to point to the right one. I have tried to add an input box to prompt the user for the column name:
Public Sub Sort_To_Tabs()
Column = InputBox("Please Enter the Column you would like to sort", "Sort To Tabs")
Range("BV1") = Column
Const TEST_COLUMN As String = "Column" '<=== change to suit
Dim i As Long
Dim iLastRow As Long
Dim iRow As Long
Dim sh As Worksheet
With ActiveSheet
iLastRow = .Cells(.Rows.Count, TEST_COLUMN).End(xlUp).Row
For i = 2 To iLastRow
Set sh = Nothing
On Error Resume Next
Set sh = Worksheets(.Cells(i, TEST_COLUMN).Value)
On Error GoTo 0
If sh Is Nothing Then
Set sh = Worksheets.Add
sh.Name = .Cells(i, TEST_COLUMN).Value
.Rows(1).Copy sh.Range("A1")
iRow = 2
Else
iRow = sh.Cells(sh.Rows.Count, TEST_COLUMN).End(xlUp).Row
iRow = iRow + 1
End If
.Rows(i).Copy sh.Range("A" & iRow)
Next i
.Activate
End With
End Sub
, but keep getting an error (I believe that this may have to do with the Const, but am not sure).
Does anyone have any suggesstions on how this can be rectified?
Thank you
Bookmarks