循环为一行中的每个新数据创建一个新工作表-MSExcel

试试这个:

Sub Breakout()
Dim FinalRow As Long, I As Long
Dim sheetNm As String
Dim shtD As Worksheet, sht1 As Worksheet
Dim wb As Workbook

    Set wb = ActiveWorkbook
    Set sht1 = wb.Worksheets("Sheet1")
    FinalRow = sht1.Cells(Rows.Count, "A").End(xlUp).Row

    For I = 1 To FinalRow  'initiates a loop

        sheetNm = sht1.Cells(I, "B").Value
        'already a sheet for this?
        Set shtD = Nothing
        On Error Resume Next
        Set shtD = wb.Worksheets(sheetNm)
        On Error GoTo 0
        'no sheet already - create one
        If shtD Is Nothing Then
            Set shtD = wb.Worksheets.Add(after:=wb.Worksheets(wb.Worksheets.Count))
            shtD.Name = sheetNm
        End If
        'copy the values
        shtD.Cells(Rows.Count, "A").End(xlUp).Offset(1, 0).Resize(1, 6).Value = _
                sht1.Cells(I, "A").Resize(1, 6).Value

    Next I

    sht1.Activate

End Sub