Excel VBA 7.54按照工作表名称拆分工作表，同时增加不存在工作表

一起学习，一起进步~~

今天我们继续来分享下关于工作表的拆分的场景，今天的这个场景是另外一个小伙伴给我提供的场景，他针对的工作场景和我们之前的普通的拆分又有点不一样的，这里在进行单个工作表的拆分的过程中，还需要寻找对应的工作表，并且将对应的数据补充进去，如果恰好，某个分类的工作表在工作表中不存在还需要自动添加对应的工作表，好像有点挑战性，我们来一起看看

场景说明

老规矩，我们依然是来模拟下数据源，根据实际的工作场景来进行分析

这是我们手上的数据表，留意数据表中的不同，工作表中总共有有5个工作表，一个总表，剩下的4个是分表，但是分表中有一个高三10班在我们的总表数据源中是不存在的，相对的，在我们的总表数据元中，也有一个高四年级是不存在的，但是高四年级是有数据的，这里我们来看看如何实现拆分，又不造成数据的流失、

代码区

来看看代码吧

Sub ss()Dim rng As Range, firstr As Range, sth As Worksheet, str$, sthf As WorksheetSet sthf = ActiveSheetSet rng = Application.InputBox("请选择表头区域", "表头区域的确定", , , , , , 8)TitleR = rng.Rows.CountTitleC = rng.ColumnTitleColNum = rng.Columns.Countstr = InputBox("请输入拆分标准列的列数")num = Int(str)l = ActiveSheet.Cells(Rows.Count, TitleR).End(xlUp).RowSet firstr = Cells(TitleR + 1, num)For i = TitleR + 2 To l + 1 If Cells(i, num) <> firstr Thenline: For Each sth In Worksheets k = k + 1 If sth.Name = firstr Then l1 = sth.Cells(Rows.Count, 1).End(xlUp).Row Range(firstr.Offset(0, -1), Cells(i - 1, TitleColNum + TitleR - 1)).Copy sth.Cells(l1 + 1, 1) Set firstr = Cells(i, num) k = 0 Exit For Else If k = Worksheets.Count Then Worksheets.Add after:=Worksheets(Worksheets.Count) rng.Copy ActiveSheet.Cells(1, 1) ActiveSheet.Name = firstr sthf.Activate k = 0 GoTo line End If End If Next sth End IfNext iEnd Sub

并不算是太长，我们这里来看看代码执行的过程

老规矩，先来选择下表头

然后我们在确定下拆分标准的列数

然后就可以出结果了，来看看

看看并不存在的高四年级如何

新建了工作表，并且增加了数据

那么完全不存在的高三10班呢

刚刚静静，没有添加任何数据，达到了我们的要求。

代码分析

来一起分析下今天的代码

前面的代码比较的简单，大家应该都懂了，我们直接进入正题

Set firstr = Cells(TitleR + 1, num)

和之前写法有些类似，这里又是指向具体的某个单元格，我们来定位下

定位到了，它就是班级的第一个单元格，然后我们开始往下循环，当寻找到第一个不等于firstr的时候，证明数据区找到了，

上面的一系列的数据班级都是等于firstr，然后我们去下面的工作表中寻找班级名字为 firstr的工作表。

然后获取这个工作表的总行数，然后填充数据

l1 = sth.Cells(Rows.Count, 1).End(xlUp).RowRange(firstr.Offset(0, -1), Cells(i - 1, TitleColNum + TitleR - 1)).Copy sth.Cells(l1 + 1, 1)

这个对大家来说，应该已经没有难度了，毕竟这个区域的获取和探索，我们已经前后进行了好几节了。

然后我们还需要做一件事，重新定义firstr，将它赋值为新的班级的值，以方便我们进行下一个循环

Set firstr = Cells(i, num)

但是如果碰到了不存在的工作表怎么办，这里有高四年级，但是我们的工作表没有高四年级，所以我们要新增一个工作表，新增工作表的操作很简单的，大家都熟悉了，但是这里有一个重点就是如何判断是循环完了所有的工作表呢？

我们这里声明一个变量k ,用它来记录我们循环的次数，如果当k刚好等于Worksheets.Count，就是工作表的总数的时候，就代表了循环了所有的工作表了，这个时候如果都没有找到合适的工作表，那就是证明真的不存在这样的工作表，然后我们就可以创建符合条件的工作表了。

Worksheets.Add after:=Worksheets(Worksheets.Count)rng.Copy ActiveSheet.Cells(1, 1)ActiveSheet.Name = firstr

有了符合条件的工作表之后呢，这里有两种选择，你可以新建工作表+数据填充两个动作写在一起，不过这样就是会导致代码比较的长，有点不好看，

或者你可以选择和我一样，用 GoTo line进行调转，重新进行一次循环

重新进行循环的时候，我们新增加的工作表已经进入到worksheets里面了，他就会循环到我们新增的工作表并且填充数据了。

这里很多的前辈都说GOTO这个方法最好不好使用，但是我个人的理解是偶尔在程序中使用一个是没有问题的，他可以节省我们的代码量，但是大量的使用，我也是不推荐的，这点大家可以根据自己的需要选择使用。

==============================

本节课的案例源码已经上传，需要的小伙伴后台私信“7-54-H6”，希望大家多支持~~，多多关注 ~ ~

好了，明晚21:00,准时再见!

因为公众号没有留言功能（开的比较晚），所以建立一个线下微信群，主要为大家提供一个交流的平台，同时大家也可以提一些对公众号的意见和看法，大家一起学习，一起进步。