Parse Functions‎ > ‎

Columns to Sheets

                             Sample File:   ColumnsToSheets.xls

"I have a data sheet with columns of data I need to parse out to separate sheets.  There are several columns at the start that need to appear on every sheet, but then the data columns need to go on separate sheets in groups of columns.  I might want to put 1 data column on each sheet, or perhaps 2-3 columns go together, in that case I would need the groups of columns to appear on each sheet.  I need to be able to set that each time the macro runs.

EXAMPLE:                                      Sheet1 (data sheet)
  A B C D E F G H I J K L M
1 Main1 Main2 Main3 Column1 Column2 Column3 Column4 Column5 Column6 Column7 Column8 Column9 Column10
2 A1 B1 C1 c d e f g h i j k l
3 A2 B2 C2 c d e f g h i j k l
4 A3 B3 C3 c d e f g h i j k l
5 A4 B4 C4 c d e f g h i j k l
6 A5 B5 C5 c d e f g h i j k l
7 A6 B6 C6 c d e f g h i j k l
8 A7 B7 C7 c d e f g h i j k l
9 A8 B8 C8 c d e f g h i j k l

(with column 4 as first "data column" and groups of columns = 2)
  A B C D E
1 Main1 Main2 Main3 Column1 Column2
2 A1 B1 C1 c d
3 A2 B2 C2 c d
4 A3 B3 C3 c d
5 A4 B4 C4 c d
6 A5 B5 C5 c d
7 A6 B6 C6 c d
8 A7 B7 C7 c d
9 A8 B8 C8 c d



  1. Macro prompts user to enter the first column that has "data" to transfer
  2. Macro prompts user to indicate how many columns make up a "data group".
  3. All columns before the first "data column" will appear on every sheet


Option Explicit

Sub ColumnsToSheets()
'Author:    Jerry Beaucaire
'Date:      8/7/2011
'Summary:   Create separate sheets from the columns of a data sheet

Dim wsData   As Worksheet   'Sheet with data to parse
Dim FirstCol As Long        'This is the first column to transfer
Dim ColCnt   As Long        'This is how many columns in a group to transfer
Dim LastCol  As Long        'check row1 to see how many columns of data there are
Dim NewSht   As Long        'how many new sheets will be created

FirstCol = Application.InputBox("Which column is the first 'data column' to transfer?" _
    & vbLf & "(A=1, B=2, C=3, etc...)" _
    & vbLf & "(All columns to the left will appear on every sheet)", _
    "First Data Column", 2, Type:=1)
If FirstCol = 0 Then Exit Sub

ColCnt = Application.InputBox("How many data columns are in each group?", _
    "Groups of Columns", 1, Type:=1)
If ColCnt = 0 Then Exit Sub

Set wsData = ActiveWorkbook.Sheets("Sheet1")
Application.ScreenUpdating = False

With wsData
    LastCol = .Cells(1, .Columns.Count).End(xlToLeft).Column
    For NewSht = FirstCol To LastCol Step ColCnt
        Sheets.Add , After:=Sheets(Sheets.Count)
        .Columns(1).Resize(, FirstCol - 1).Copy Range("A1")
        .Columns(NewSht).Resize(, ColCnt).Copy Cells(1, FirstCol)
    Next NewSht
End With

Application.ScreenUpdating = True
End Sub

Nothing says "thanks" like a steak dinner!
PayPal - The safer, easier way to pay online!