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