VBA方法拆分工作表

送人玫瑰，手有余香，请将文章分享给更多朋友

动手操作是熟练掌握EXCEL的最快捷途径！

【置顶公众号】或者【设为星标】及时接收更新不迷路

小伙伴们好，拆分工作表是日常工作中经常会遇到的问题之一。当然，也有很多种方法可以用来处理这个问题，公式、数据透视表都是很好用的方法。

今天将着重介绍一下如何使用VBA来拆分工作表。原题目是下面这个样子的：

题目要求将源数据按照省市名称拆分成4中工作表。

这道题目并不像想象的那样简单，要考虑到原工作簿中是否已经存在名称为“北京市”、“上海市”、“天津市”和“重庆市”这4张工作表。如果这4张工作表已经存在了，就只需要向每个工作表中复制数据即可；如果不存在，那就需要根据源数据中B列中的信息来添加工作表。同时，因为B列中的信息是有重复的，因此还要解决在添加工作表的过程中报错的问题，即工作表名称不能相同。如果添加工作表时，该名称已经被添加了，就停止添加该工作表。

先来看第一种情况。

完整代码如下：

Sub 拆分工作表()    Dim i As Integer, sht As Worksheet, Shtname As String, sht1 As Worksheet, rng As Range    Set sht = ActiveSheet    For Each sht1 In Worksheets        If sht1.Name <> " 数据表" Then            sht.Cells(1, 1).Resize(1, 3).Copy sht1.Cells(1, 1)        End If    Next    i = 2    Do While sht.Cells(i, 2) <> ""        Shtname = sht.Cells(i, 2).Value        Set rng = Worksheets(Shtname).Cells(Rows.Count, 1).End(xlUp).Offset(1, 0)        sht.Cells(i, 1).Resize(1, 3).Copy rng        i = i + 1    LoopEnd Sub

第4-8行代码：循环给每个工作表添加表头。

第10-15行代码：根据B列中的名称信息，将对应的信息复制到对应的工作表中，按先后顺序依次排列。

下面来看看第二种情况。如果源数据中仅仅只有一张工作表储存源数据，需要在拆分的同时添加对应的工作表，则需要判断工作表是否已经存在。代码会稍复杂些。

完整代码如下：

Dim Shtname As StringSub 拆分工作表2()    Dim i As Integer, sht As Worksheet, rng As Range    Set sht = ActiveSheet    i = 2    Do While sht.Cells(i, 2) <> ""        Shtname = sht.Cells(i, 2).Value        If Sht_exist(Shtname) = True Then            Set rng = Worksheets(Shtname).Cells(Rows.Count, 1).End(xlUp).Offset(1, 0)            sht.Cells(i, 1).Resize(1, 3).Copy rng        Else            Worksheets.Add(after:=Worksheets(Worksheets.Count)).Name = Shtname            sht.Cells(1, 1).Resize(1, 3).Copy Worksheets(Shtname).Cells(1, 1)            Set rng = Worksheets(Shtname).Cells(Rows.Count, 1).End(xlUp).Offset(1, 0)            sht.Cells(i, 1).Resize(1, 3).Copy rng        End If        i = i + 1    LoopEnd SubFunction Sht_exist(Shtname As String) As Boolean    Dim is_exist As Boolean    On Error Resume Next    Err.Clear    Shtname = Worksheets(Shtname).Name    If Err.Number = 0 Then        is_exist = True    Else        is_exist = False    End If    Sht_exist = is_existEnd Function

第20-31行代码，自定义函数，对工作表是否存在做判断，并在过程中调用此函数。这样可以使代码结构更加清晰。

第6-19行代码：循环。调用自定义函数Sht_exist，判断给定的工作表是否存在。如果存在，则不需复制表头信息；如果不存在，则首先需要添加该工作表，之后复制表头信息，最后复制数据。

本期内容练习文件提取方式：

链接：https://pan.baidu.com/s/1aXCezDoX6B2RJ_RjUHJmrw?pwd=l5jo

提取码：l5jo

好了朋友们，今天和大家分享的内容就是这些了！喜欢我的文章请分享、转发、点赞和收藏吧！如有任何问题可以随时私信我哦！

-END-

长按下方二维码关注EXCEL应用之家

面对EXCEL操作问题时不再迷茫无助

我就知道你“在看”