VBA-拆分多个工作簿

VBA-拆分多个工作簿

通过手工键入行列数将总表拆分为多个工作簿

Sub 拆分成多个工作簿()
'将报表按指定列分类并保存到各工作表中
Dim i, c As Long, bj As String, rng As Range, arr(), myrows, lc As Integer
Application.ScreenUpdating = False
Application.DisplayAlerts = False
myrows = Application.InputBox("请输入内容从第几行开始")    '分类处理的第一条记录在第几行
i = myrows
c = Application.InputBox("请输入拆分列号")
arr = Range("A1").CurrentRegion
lc = UBound(arr, 2)
 
bj = Worksheets(1).Cells(i, c).Value
Do While bj <> ""                                                 '直到工作表中选中列的单元格为空单元格时终止循环
    
    On Error Resume Next                                          '当没有对应工作表时，忽略下一行代码引起的运行错误
    If Worksheets(bj) Is Nothing Then                                                                   '判断是否已有工作表，没有就新建并写入表头
        Worksheets.Add after:=Worksheets(Worksheets.Count)
        ActiveSheet.Name = bj
        Worksheets(1).Cells(1, "A").