将多列数据导出到多张工作表中

Question

I would like to export some column data into separate sheets which I will then export into individual ASCII text files. The specific data are as shown whereby I would like to copy the first two columns (x, y coordinates) and each individual column thereafter into its own sheet.

 x     y    Comp1   Comp2   Comp3   Comp4    …  Comp23
-40  -20    55.29   0       0       73       …  105.67
-40  -19.9  56.79   0       33      72       …  112.5
-40  -19.8  69.29   0       31      89       …  114
-40  -19.7  70.29   0       58.14   108      …  125
 …    …     …       …       …       …        …  …
 40   55    72.29   0       49      117      …  132

I'm still getting to grips with writing macros so right now I am basically trying to adapt a recorded macro for one of the iterations to work for the entire sheet which looks as follows:

Sub CopyColData()
    ActiveCell.Range("A1:B1").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Copy
    Sheets.Add After:=ActiveSheet
    ActiveSheet.Paste
    Sheets("Sheet1").Select
    Sheets("Sheet1").Name = "Comp1"
    Sheets("SUM").Select
    Application.CutCopyMode = False
    ActiveCell.Offset(0, 2).Range("A1").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Copy
    Sheets("Comp1").Select
    ActiveCell.Offset(0, 2).Range("A1").Select
    ActiveSheet.Paste
End Sub 

Ideally I would like it to create a new worksheet for each column with the coordinate data in the first two columns, label the worksheet according to the column title and then copy the column data onto the third column. Afterwards I'll export the multiple sheets into individual ASCII files using a different macro. Thanks!

Answer 1

All thanks to Jerry Beaucaire (again!) but I added a counter for sheet naming:

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
Dim inti As Integer         'counter for sheet naming

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
inti = 1
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)
        ActiveSheet.Name = "Comp" & inti
        inti = inti + 1
    Next NewSht
  End With
Application.ScreenUpdating = True
End Sub