写了一个VBA宏程序，用来自动将EXCEL一列转换为不同的工作表。例如：

姓名  性别

张三  男

李四  女

通过该程序可以自动分离出“男”工作表和“女”工作表。先上代码，注释写的很清楚。

在excel中先使用alt+F11组合键打开代码窗口，在当前项目中新建一个模块（modules），复制代码到当前模块。使用ctrl+G打开调试窗口，复制代码并执行。

'时间：2/6/2015
'版本：1.0

'宏SeperateColumn用来将当前工作表，按某一列进行分类，每一类新建为以该值变量命名的工作表中，工作表第一行为表头，不进行分离;
'注意：使用前请提前备份工作簿，最好先搜索目标列确认列值符合工作表命名规范

Sub SeperateColumn()

  '定义了需要分离的列
  Dim col As Integer
  
  '从选择的行开始进行迭代分离col列*********************
  col = getSeperateCol()
  
 
     '取得当前工作表的最大行数tableRows
     Dim tableRows As Integer
     tableRows = ActiveSheet.Range("A65535").End(xlUp).Row
     
     '取得当前工作表的名字
     Dim tableName As String
     tableName = ActiveSheet.Name()
     
        '对当前工作表从第二行开始迭代（第一行为表头），取col列的值进行处理
        Dim stringEveryItem As String
        For Index = 2 To tableRows
        
            stringEveryItem = ActiveSheet.Cells(Index, col)
            
            '如果此值在所有的工作表中五法找到则新建一个该名称的工作表并且将该行插入
            If stringExistWorkSheet(stringEveryItem) = False Then
               resultAddsheet = addWorkSheetCopyFirstRow(tableName, stringEveryItem)
               resultInsertSheet = copyRowToWorksheet(tableName, Index, stringEveryItem)
                
            '若此值在所有工作表中能找到，则直接插入到该工作表中
            Else
               resultInsertExistSheet = copyRowToWorksheet(tableName, Index, stringEveryItem)
            End If
        Next
                
  Debug.Print "转换完成"
  
  MsgBox "转换完成 Seperate Completed.", vbInformation, "运行结果RESULT"
        
  
End Sub

'函数stringExistWorkSheet()判断通过值传递来的value_name是否在本workbook中存在该worksheet（这里不区分大小写）
Function stringExistWorkSheet(ByVal value_name As String) As Boolean
    
    '先定义一个Worksheet对象
    Dim sht As Worksheet
    
    '默认下找不到该Worksheet
    stringExistWorkSheet = False
    
    '下面对该Workbook进行遍历
    For Each sht In ActiveWorkbook.Worksheets
        '比较时worksheet和value_name不区分大小写
        If VBA.LCase(sht.Name) = VBA.LCase(value_name) Then
            stringExistWorkSheet = True
            Exit Function
            
        End If
    Next
End Function
'函数addWorkSheetCopyFirstRow(tableName,sName)用来新建一个以sName的工作表，并且将tableName工作表的第一行复制到新工作表的第一行
Function addWorkSheetCopyFirstRow(ByVal tableName As String, ByVal sName As String) As Boolean

    addWorkSheetCopyFirstRow = False

    '插入制定名称的工作表
    Worksheets.Add.Name = sName
    
    Debug.Print "创建新工作表"; sName; "成功"
    
    '选中主表的第一行
     Worksheets(tableName).Activate
     Rows(1).Select
    '复制选中的第一行
    Selection.Copy
    
    '选中新建表的第一行
    Sheets(sName).Activate
    Rows(1).Select
    '粘贴
    ActiveSheet.Paste
    
    addWorkSheetCopyFirstRow = True
    Worksheets(tableName).Activate '最后将当前活动工作表还原为主表
    
    Debug.Print "已经复制第一行到"; sName; "工作表"
    
End Function
'copyRowToWorksheet函数用来从tableNameCopy工作表中选取第tableNameCopyRow行，然后复制到tableNamePaste表中
Function copyRowToWorksheet(ByVal tableNameCopy As String, ByVal tableNameCopyRow As Single, ByVal tableNamePaste As String) As Boolean
    
    copyRowToWorksheet = False
    
    '首先将主表设为活动表，选取某行进行复制
    Worksheets(tableNameCopy).Activate
    Rows(tableNameCopyRow).Select
    Selection.Copy
    
    '其次将要粘贴的目的表设为活动表，选取其尾部的行进行粘贴
    Worksheets(tableNamePaste).Activate
    
    '这里使用目的表的最后一行
    Dim rowNumber As Integer
    rowNumber = ActiveSheet.Range("A65535").End(xlUp).Row + 1
    
    Rows(rowNumber).Select
    ActiveSheet.Paste
    
  
    '粘贴成功后还原活动表
    copyRowToWorksheet = True
    Worksheets(tableNameCopy).Activate
    
End Function
'getSeperateCol函数通过使用inputbox提供用户选择输入，用来获得需要分离的列，这里先使用数字，后续添加输入列名的功能
Function getSeperateCol() As Integer
    Dim colIndex As Integer
    
    '这里使用VBA.InputBox提供用户交互
    colIndex = VBA.InputBox("请输入需要分离的列序号（数字）Please input the index of the column which you want to seperate.(Integer)", "选择框CHOOSEBOX")
    
    '这里提供给用户确认选择框
    MsgBox "需要转换的列序号 Column Index:" & colIndex, vbInformation, "提示NOTICE"
    
    getSeperateCol = colIndex
         
End Function
                            

简述下自己的编程思想：

首先遍历当前工作表的第二行至最后一行，根据选定的列进行迭代；这里，通过拆分功能区域，将程序拆分出1.遍历所有工作表名称。2，新建工作表并复制第一行。3，复制某一行到目标工作表。4，用户交互。4个函数区，分别实现测试，然后在主函数中调用。有效降低了编程的复杂性。