VBA从Sheet1 +中的唯一列值创建新工作表，并显示相邻行信息

Sub CreateNewSheet()
    Dim sourceSheet As Worksheet
    Dim newSheet As Worksheet
    Dim lastRow As Long
    Dim uniqueValues As Collection
    Dim cellValue As Variant
    
    ' 获取源工作表
    Set sourceSheet = ThisWorkbook.Sheets("Sheet1")
    
    ' 获取源工作表中唯一列的最后一行
    lastRow = sourceSheet.Cells(sourceSheet.Rows.Count, "A").End(xlUp).Row
    
    ' 创建一个集合用于存储唯一值
    Set uniqueValues = New Collection
    
    ' 遍历唯一列的值，并将唯一值添加到集合中
    For i = 2 To lastRow
        cellValue = sourceSheet.Cells(i, "A").Value
        On Error Resume Next
        uniqueValues.Add cellValue, CStr(cellValue)
        On Error GoTo 0
    Next i
    
    ' 根据唯一值创建新工作表，并显示相邻行的信息
    For Each cellValue In uniqueValues
        ' 创建新工作表
        Set newSheet = ThisWorkbook.Sheets.Add(After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count))
        newSheet.Name = "Sheet_" & cellValue
        
        ' 在新工作表中显示相邻行的信息
        For i = 2 To lastRow
            If sourceSheet.Cells(i, "A").Value = cellValue Then
                ' 复制相邻行的信息到新工作表
                sourceSheet.Rows(i).Copy newSheet.Cells(newSheet.Cells(newSheet.Rows.Count, "A").End(xlUp).Row + 1, "A")
            End If
        Next i
    Next cellValue
End Sub