Question

我想将一些列数据导出到单独的表格中，然后我将导出到单独的ASCII文本文件中。具体数据如图所示，我希望将前两列（x，y坐标）和每个单独的列复制到其自己的工作表中。

 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

我现在仍然处理编写宏的问题，所以我现在基本上试图调整一个记录的宏来完成整个工作表的迭代之一，如下所示：

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

理想情况下，我希望为前面两列中的坐标数据为每列创建一个新工作表，根据列标题标记工作表，然后将列数据复制到第三列。之后，我将使用不同的宏将多个工作表导出到单个ASCII文件中。谢谢！

Answer 1

所有感谢Jerry Beaucaire（再次！）但我添加了一个表格命名计数器：

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

将多列中的数据导出为多个工作表

1 个答案: