VBA 按B列拆分工作表

Sub SplitData() Dim lastRow As Long Dim currentRow As Long Dim currentName As String Dim currentSheet As Worksheet

'获取最后一行
lastRow = ActiveSheet.Cells(Rows.Count, "B").End(xlUp).Row

'遍历行
For currentRow = 2 To lastRow
    '获取当前名称
    currentName = ActiveSheet.Cells(currentRow, "B").Value
    
    '如果当前名称没有对应的工作表，则创建一个
    On Error Resume Next
    Set currentSheet = Worksheets(currentName)
    On Error GoTo 0
    If currentSheet Is Nothing Then
        Set currentSheet = Worksheets.Add
        currentSheet.Name = currentName
        '将标题行复制到新工作表
        Rows(1).Copy currentSheet.Rows(1)
    End If
    
    '将当前行数据复制到对应工作表的下一行
    Rows(currentRow).Copy currentSheet.Rows(currentSheet.Cells(Rows.Count, "B").End(xlUp).Row + 1)
Next currentRow

End Sub