Sub SplitSheet() Dim wb As Workbook Set wb = ThisWorkbook '替换为您要操作的工作薄 Dim ws As Worksheet Set ws =

Sub SplitSheet() Dim wb As Workbook Set wb = ThisWorkbook 'Replace with the workbook you want to operate on Dim ws As Worksheet Set ws = wb.Sheets("Sheet1") 'Replace with the worksheet you want to split Dim lastRow As Long lastRow = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row 'Get the row number of the last row Dim i As Long For i = 2 To lastRow 'Loop through rows starting from the second row, because the first row is the header Dim sheetName As String sheetName = ws.Cells(i, 1).Value 'Replace with the cell you want to name the new sheet after If sheetName <> "" Then 'If the cell is not empty, create a new sheet and copy data Dim newSheet As Worksheet Set newSheet = wb.Sheets.Add(After:=wb.Sheets(wb.Sheets.Count)) newSheet.Name = sheetName ws.Range("A1:F1").Copy 'Copy the header row newSheet.Range("A1:F1").PasteSpecial xlPasteAll 'Paste the header row ws.Range("A" & i & ":F" & i).Copy 'Copy the current row newSheet.Range("A2:F2").PasteSpecial xlPasteAll 'Paste the current row End If Next i End Sub