Sub Split()
 Const header_row = 1
 Const starting_row = 2
 Dim select_rng As Range
 Dim vcol As Long
 Dim source_sheet As Worksheet
 Dim destination_sheet As Worksheet
 Dim source_row As Long
 Dim destination_row As Long
 Dim last_row As Long
 Dim region As String
 
 Set Rng = Application.InputBox("Select the Colomn to Split:", "Column Select", "", Type:=8)
 vcol = Rng.Column
 
 Set source_sheet = ActiveSheet
 last_row = source_sheet.Cells(source_sheet.Rows.Count, vcol).End(xlUp).Row
 For source_row = starting_row To last_row
 region = source_sheet.Cells(source_row, vcol).Value
 Set destination_sheet = Nothing
 On Error Resume Next
 Set destination_sheet = Worksheets(region)
 On Error GoTo 0
 If destination_sheet Is Nothing Then
 Set destination_sheet = Worksheets.Add(after:=Worksheets(Worksheets.Count))
 destination_sheet.Name = region
 source_sheet.Rows(header_row).Copy Destination:=destination_sheet.Rows(header_row)
 End If
 destination_row = destination_sheet.Cells(destination_sheet.Rows.Count, vcol).End(xlUp).Row + 1
 source_sheet.Rows(source_row).Copy Destination:=destination_sheet.Rows(destination_row)
 Next source_row
 
 
End Sub