Does this function already exist? If yes, then which one is it? If not, is this something you could work your magic on to make happen?"
This is not a tool that already exists in ASAP Utilities. I will add one however.
In the mean time you can use the following macro. It will create a new worksheet for each column in your selection and copies the data from that column to the new worksheet. After you have run this macro you can use ASAP Utilities to export each worksheet as a new file.
Sub sbColumnsToSheets()
' Purpose: Create a separate worksheet for each column in your selection ' the name of the sheet will be the name of the first row in each column. ' Usage:
' first select the cells then run this macro
Dim rngSelection As Range
Dim wsStart As Worksheet
Dim wsNew As Worksheet
Dim lRowLast As Long
Dim lCollast As Long
Dim lRowFirst As Long
Dim lColFirst As Long
Dim lCol As Long
Dim strSheetName As String
On Error GoTo sbColumnsToSheets_Error
' Quit of no range selected
If UCase(TypeName(Selection)) <> "RANGE" Then
MsgBox "Please select the range with the columns you want to " & vbNewLine & _
"copy into separate sheets.", vbCritical
Exit Sub
End If
If MsgBox("Do you want to copy each one of the " & Selection.Columns.Count & _
" columns in your selection to a new worksheet?", _
vbQuestion + vbYesNo) = vbNo Then Exit Sub
Application.ScreenUpdating = False
Set wsStart = ActiveSheet
Set rngSelection = Selection
lRowFirst = rngSelection.Cells(1).Row
lColFirst = rngSelection.Cells(1).Column
lRowLast = rngSelection.Cells(rngSelection.Cells.Count).Row
lCollast = rngSelection.Cells(rngSelection.Cells.Count).Column
' loop through the columns
For lCol = lColFirst To lCollast
Application.StatusBar = "Processing column " & lCol & " of " & lCollast - lColFirst + 1
' add a new sheet at the end
ActiveWorkbook.Sheets.Add after:=Sheets(Sheets.Count), Type:=xlWorksheet
' make sure the new sheet name is unique
strSheetName = fnUniqueSheetName(rngSelection.Cells(lRowFirst, lCol).Value)
ActiveSheet.Name = strSheetName
Set wsNew = ActiveSheet
' copy the column from the original sheet
wsStart.Activate
wsStart.Range(Cells(lRowFirst, lCol), Cells(lRowLast, lCol)).Copy
' paste the data into the new sheet
wsNew.Range("A1").PasteSpecial xlPasteValues
wsNew.Paste
Application.CutCopyMode = False
Next lCol
wsStart.Activate
Application.ScreenUpdating = True
Application.StatusBar = False
On Error GoTo 0
Exit Sub
sbColumnsToSheets_Error:
Application.ScreenUpdating = True
Application.StatusBar = False
MsgBox "Error " & Err.Number & " (" & Err.Description & ")" & _
"in procedure sbColumnsToSheets", vbCritical
End Sub
Private Function fnUniqueSheetName(strName As String) As String
' Loop through all sheets and see if the name already exists
' if is does, add a number to the name and check again.
' Repeat until a unique name is found
' The maximum length for a sheetname is 31 characters.
Dim objSheet As Object
Dim strNewName As String
Dim i As Long
' Certain characters are not allowed in a sheet's namea:
strName = Replace(strName, ":", "_")
strName = Replace(strName, "\", "_")
strName = Replace(strName, "/", "_")
strName = Replace(strName, "?", "_")
strName = Replace(strName, "*", "_")
strName = Replace(strName, "[", "_")
strName = Replace(strName, "]", "_")
strNewName = strName
i = 1
If Len(strNewName) > 31 Then
strNewName = Left(strNewName, 21) & ".." & Right(strNewName, 8)
End If
Start:
For Each objSheet In ActiveWorkbook.Sheets
If objSheet.Name = strNewName Then
strNewName = strName & " (" & i & ")"
If Len(strNewName) > 31 Then
strNewName = Left(strNewName, 21) & ".." & Right(strNewName, 8)
End If
i = i + 1
GoTo Start
Exit For
End If
Next
fnUniqueSheetName = strNewName
End Function