exel VBA拆分工作表

　　客户经理每个月要拜访很多客户，公司要求必须要一个拜访记录汇总表并且要做一个拜访客户的分表，以便主管抽查，表的结构如图一。这个时候如果一个客户一个客户填的话就很烦很耗时间。我们可以做一个VBA按钮，每个月只要把汇总部分填好后，只要点击一下该按钮，就自动生成和客户信息的分表，省力又省心。

图一

先贴代码：

Sub cfsheet()
Dim rng As Range, sht As Worksheet
Set rng = Application.InputBox("请选择需要拆分的列", "拆分另存为工作表...", , , , , , 8)
Set sht = rng.Parent
    \'获取工作表名称
    With sht
        rng.EntireColumn.Copy [az1]
        Range("az:az").RemoveDuplicates (1)
    End With
    
    \'删除工作表
    Application.DisplayAlerts = False
    For i = Sheets.Count To 3 Step -1
        Sheets(i).Delete
    Next
    Application.DisplayAlerts = True
        
    \'新建工作表
    Application.ScreenUpdating = False
    rw = [az1000].End(3).Row
    For i = 2 To rw
        shtName = sht.Range("az" & i).Value
        Sheets.Add(after:=Sheets(Sheets.Count)).Name = shtName
        Sheets("拜访记录表").Activate
        Cells.Copy Sheets(i + 1).[a1]
        Sheets(i + 1).Range("b2") = Sheets("汇总表").Range("a" & i)
        Sheets(i + 1).Range("d2") = Sheets("汇总表").Range("b" & i)
        Sheets(i + 1).Range("b3") = Sheets("汇总表").Range("c" & i)
        Sheets(i + 1).Range("d3") = Sheets("汇总表").Range("d" & i)
        Sheets(i + 1).Range("b4") = Sheets("汇总表").Range("e" & i)
        Sheets(i + 1).Range("b5") = Sheets("汇总表").Range("f" & i)
        Sheets(i + 1).Range("b6") = Sheets("汇总表").Range("g" & i)
        Sheets(i + 1).Range("b7") = Sheets("汇总表").Range("h" & i)
        Sheets(i + 1).Range("b8") = Sheets("汇总表").Range("i" & i)
    Next
    Application.ScreenUpdating = True
    Sheets("汇总表").Range("az:az").Clear
       
End Sub

把代码导出为加载项，再添加到工具栏，每个月就只须一点报表就OK了。

简单说明一下我的思路：

1、先定位要拆分的列，根据列把表拆分为单表。这里我采用的是把这列复制到新的一列，然后现根据这列来新建工作表，这样做目的是如果你不能够保证没有重复的话，可以添加去重的功能（我没有加）。为了能重复使用，再每次新建前，都把上一次新建的删除；

2、把拜访记录表复制到新建的各个表中，并且把汇总表中的各类信息填入拜访记录表中对应的位置；

3、释放过程中用过的列。