VBA一键将总表按任意列拆分为多个工作簿

2023-12-12 17:00:52

前言

大家好，我是星光。今天和大家分享的VBA小代码是：一键将总表按任意列拆分为多个工作簿。

什么意思呢？举个小栗子。如下图所示，是一张总表，现在需要按任意列，比如班级列吧，将它拆分为多个工作簿。

动画演示如下：

[动画演示]

VBA代码如下：

Sub SplitTableByColumn()
    Dim wb As Workbook
    Dim ws As Worksheet
    Dim rng As Range
    Dim col As Long
    Dim lastRow As Long
    Dim i As Long
    Dim newWb As Workbook

    Set wb = ThisWorkbook
    Set ws = wb.Worksheets("Sheet1")
    Set rng = ws.UsedRange

    ' 获取要拆分的列号
    col = Application.InputBox("请输入要拆分的列号：", "拆分列号", 1, Type:=1)

    ' 获取总表的最后一行
    lastRow = rng.Rows.Count

    ' 循环遍历每一行
    For i = 2 To lastRow
        ' 获取当前行的值
        val = rng.Cells(i, col).Value

        ' 如果当前行不为空
        If val <> "" Then
            ' 创建一个新的工作簿
            Set newWb = Workbooks.Add

            ' 将当前行数据复制到新工作簿
            rng.Rows(i).Copy newWb.Worksheets(1).Range("A1")

            ' 保存新工作簿
            newWb.SaveAs "C:\Users\Public\Desktop\" & val & ".xlsx"

            ' 关闭新工作簿
            newWb.Close
        End If
    Next i

    ' 提示操作完成
    MsgBox "拆分完成！"
End Sub