**EDIT：**添加了工作表循环和标签名检查，并清除先前的输出

你可以这样做：

Option Explicit

Sub SplitCells()

    Dim c As Range, ws As Worksheet, v, arr, arr2, i As Long, x As Long, el
    Dim cOut As Range, wb As Workbook
    
    Set wb = ActiveWorkbook 'or ThisWorkbook
    
    For Each ws In wb.Worksheets                       '##loop all worksheets
        If LCase(ws.Name) Like "*exceptions*" Then     '##tabname contains "exceptions" ?
            For Each c In ws.Range("h2:aw2").Cells     'loop over range in row2
                
                Set cOut = c.EntireColumn.Cells(8)     'output starts here
                cOut.Resize(1000).ClearContents        '##clear any previous data
                
                v = Trim(c.Value)                      'remove any spaces
                If Len(v) > 0 Then                     'any content?
                    arr = Split(v, vbLf)                       'split on vbLf
                    ReDim arr2(LBound(arr) To UBound(arr))     'for consolidated array
                    x = LBound(arr2)
                    For i = LBound(arr) To UBound(arr)
                        el = Trim(arr(i))
                        If Len(el) > 0 Then  'non-blank?
                            arr2(x) = el     'add to consolidated array
                            x = x + 1        'next position
                        End If
                    Next i
                    'drop the array onto the sheet below the cell being processed
                    If x > LBound(arr) Then 'EDIT: added this check
                        cOut.Resize(x).Value = Application.Transpose(arr2)
                    End If
                End If
            Next c
        End If      'tab name contains "exceptions"
    Next ws
End Sub

你的第二个场景：

Sub SplitCells()

    Dim c As Range, ws As Worksheet, rwData As Range
    Dim wb As Workbook, wsSumm As Worksheet, cOut As Range
    Dim arrJur, arrG1, arrG2, fileName, el
    
    Set wb = ActiveWorkbook                'or ThisWorkbook
    Set wsSumm = wb.Worksheets("Summary")  'summary sheet
    Set cOut = wsSumm.Range("A2")          'output starts here
    
    For Each ws In wb.Worksheets                       '##loop all worksheets
        If LCase(ws.Name) Like "*exceptions*" Then     '##tabname contains "exceptions" ?
            fileName = ws.Range("A1").Value
            Set rwData = ws.Range("A9:C9")
            Do While Application.CountA(rwData) > 0    'while have any data
                arrJur = CellValues(rwData.Cells(1))
                If Not IsEmpty(arrJur) Then            'any Jurisdictions?
                    arrG1 = CellValues(rwData.Cells(2))
                    arrG2 = CellValues(rwData.Cells(3))
                    For Each el In arrJur
                        cOut.Value = fileName               'file name
                        cOut.Offset(0, 1).Value = el        'jurisdiction
                        PutValues cOut.Offset(0, 2), arrG1  'group1
                        PutValues cOut.Offset(0, 27), arrG2 'group2
                        Set cOut = cOut.Offset(1) 'next output row
                    Next el
                
                End If
                Set rwData = rwData.Offset(1) 'next data row
            Loop
        End If      'tab name contains "exceptions"
    Next ws
End Sub

'If `arr` is not Empty, place it into a row starting at `c`
Sub PutValues(c As Range, arr)
    If Not IsEmpty(arr) Then
        c.Resize(1, UBound(arr) + 1).Value = arr
    End If
End Sub

'return an array of vbLf-separated non-blank values in a cell
Function CellValues(c As Range)
    Dim v As String, arr, col As New Collection, el
    v = Trim(c.Value)                      'remove any spaces
    If Len(v) > 0 Then                     'any content?
        arr = Split(v, vbLf)                       'split on vbLf
        For Each el In arr
            el = Trim(el)
            If Len(el) > 0 Then col.Add el 'non-blank?
        Next el
    End If
    CellValues = ColToArray(col)
End Function

'load a Collection to a 1D array
Function ColToArray(col As Collection)
    Dim i, arr
    If col.Count > 0 Then
        ReDim arr(0 To col.Count - 1)
        For i = 1 To col.Count
            arr(i - 1) = col(i)
        Next i
        ColToArray = arr
    Else
        ColToArray = Empty
    End If
End Function