VBA按列信息拆分数据到多工作簿

    <p>
        在实际工作中，我们经常会遇到需要将数据按列信息拆分到多个工作簿的情况，例如，按产品类别拆分销售数据、按地区拆分客户信息等等。手动拆分数据不仅耗时费力，而且容易出错。使用VBA代码可以帮助我们快速、准确地完成此类任务，从而提高工作效率。
    </p>
    <p>
        下面是一个使用VBA按列信息拆分数据到多工作簿的示例代码：
    </p>
    <pre>
    Sub 拆分数据到工作簿()
        Application.ScreenUpdating = False

        Dim ToWb As Workbook, Sht As Worksheet
        Dim LastRow As Long, LastCol As Long
        Dim i As Long, j As Long, k As Long

        ' 获取当前工作簿的最后一个工作表
        Set Sht = ActiveWorkbook.Sheets(ActiveWorkbook.Sheets.Count)
        ' 获取工作表最后一行和最后一列
        LastRow = Sht.Cells(Sht.Rows.Count, "A").End(xlUp).Row
        LastCol = Sht.Cells(1, Sht.Columns.Count).End(xlToLeft).Column

        ' 循环遍历工作表每一列
        For i = 2 To LastCol
            ' 检查列名是否为空
            If Sht.Cells(1, i).Value <> "" Then
                ' 创建新工作簿
                Set ToWb = Workbooks.Add
                ' 设置工作簿名称
                ToWb.Name = Sht.Cells(1, i).Value
                ' 复制数据到新工作簿
                For j = 2 To LastRow
                    For k = i To LastCol
                        ToWb.Sheets(1).Cells(j - 1, k - i + 1).Value = Sht.Cells(j, k).Value
                    Next k
                Next j
                ' 保存新工作簿
                ToWb.SaveAs Filename:="C:\Temp\" & ToWb.Name & ".xlsx"
                ' 关闭新工作簿
                ToWb.Close
            End If
        Next i

        Application.ScreenUpdating = True
    End Sub
    </pre>
    <p>
        该代码首先获取当前工作簿的最后一个工作表、工作表最后一行和最后一列。然后，循环遍历工作表每一列，检查列名是否为空。如果列名不为空，则创建新工作簿，并将其名称设置为列名。接着，复制数据到新工作簿，并将新工作簿保存到指定路径。最后，关闭新工作簿。
    </p>
    <p>
        使用此代码，您可以轻松地将数据按列信息拆分到多个工作簿，以便于数据管理和分析。您可以根据自己的需要修改代码，以满足不同的数据拆分需求。
    </p>
    <p>
        希望本文对您有所帮助。如果您有任何问题或建议，请随时留言。
    </p>
</body>