split data on multiple worksheets

Question

I have a workbook with over 100 worksheets that I need the data in cells "D2", "E2", "F2", and "G2" split and put in individual cells in those rows.

I've looked through every possible option on the internet. The only thing that kinda worked is using Kutools and split data into row, but I would like for it to do all the rows at the same time, rather than one at a time, and possibly each sheet automatically

I'm really new with coding and don't know where to go.

each sheet is a datatable with the first line being the headers and the second line containing the data. column D - G has information that is separated by using alt+enter, but I would like to have them now fill the information down the column. On some sheets there would be only information in D2, some will have information in all the cells, and some won't have information in any of the columns.

Input 1:

Expected Output 1:

Input 2:

Expected Output 2:

Input 3:

Expected Output 3:

Input 4:

Expected Output 4:

Answer 1

Try

Sub test()
    Dim Ws As Worksheet
    For Each Ws In Worksheets
        SplitWs Ws
    Next Ws
End Sub
Sub SplitWs(Ws As Worksheet)
    Dim vDB, rngDB As Range
    Dim vR() As Variant, vS As Variant
    Dim r As Long, i As Long, n As Long
    Dim j As Integer, k As Integer, m As Integer
    Dim c As Integer, Cnt As Integer
    Dim vRow() As Variant

    Set rngDB = Ws.Range("a1").CurrentRegion
    If rngDB.Rows.Count < 2 Then Exit Sub
    vDB = rngDB
    r = UBound(vDB, 1)
    For i = 2 To r
        k = 0
        m = 0
        '@@ The maximum value of the number of times of alt + enter
        '   used in each cell of each line is obtained.
        For j = 1 To 7
            m = m + 1
            ReDim Preserve vRow(1 To m)
            s = vDB(i, j)
            If InStr(s, Chr(10)) Then
                vS = Split(s, Chr(10))
                vRow(m) = UBound(vS)
                k = WorksheetFunction.Max(vRow)
            End If
        Next j
        n = n + k + 1
        '@@ With the array size set, only the contents of the line
        '   in which the data is located in each cell are adjusted.
        ReDim Preserve vR(1 To 7, 1 To n)
        For c = 1 To 7
            Cnt = 0
            s = vDB(i, c)
            vS = Split(s, Chr(10))
            For j = 0 To UBound(vS)
                If vS(j) <> "" Then
                    Cnt = Cnt + 1
                    vR(c, n - k - 1 + Cnt) = vS(j)
                End If
            Next j
        Next c
    Next i
    With Ws
        .UsedRange.Offset(1).Clear
        .Range("a2").Resize(n, 7) = WorksheetFunction.Transpose(vR)
    End With

End Sub

Answer 2

With all due respect and credit to Dy.Lee below, I have reworked that into this

Option Explicit
Option Base 1

Sub test()
    Dim Ws As Worksheet
    For Each Ws In Worksheets
        SplitWs2 Ws
    Next Ws
End Sub

Sub SplitWs2(Ws As Worksheet)

    ' define the input
    Dim vIN() As Variant, colIN As Integer, rowIN As Integer
    vIN = Ws.Range("a1").CurrentRegion
    'MsgBox ("ub=" & UBound(vDB, 1) & " by " & UBound(vDB, 2))  ' 4 rows by 7 columns

    ' define the output, starting out same size as input, but transposed row/column
    ' we need to add rows, and can only redim the last dimension
    Dim vOUT() As Variant, colOUT As Integer, rowOUT As Integer
    ReDim Preserve vOUT(UBound(vIN, 2), UBound(vIN, 1))

    ' step thru the input, columns and rows
    For colIN = 1 To UBound(vIN, 2)  ' to the last column
        colOUT = colIN
        rowOUT = 0

        For rowIN = 1 To UBound(vIN, 1) ' to the last row

            ' look down column at each input cell for splits
            Dim s As String, vS As Variant, k As Integer, rowAdd As Integer
            s = vIN(rowIN, colIN)
            If InStr(s, Chr(10)) Then

                vS = Split(s, Chr(10))  '  vS is base zero, so add one to UBound
                rowAdd = rowOUT + UBound(vS, 1) + 1 - UBound(vOUT, 2)
                If rowAdd > 0 Then
                    ReDim Preserve vOUT(UBound(vOUT, 1), UBound(vOUT, 2) + rowAdd)
                End If

                For k = 0 To UBound(vS)
                    rowOUT = rowOUT + 1
                    vOUT(colOUT, rowOUT) = vS(k)
                Next k

            ElseIf s > "" Then
                ' found un-split data, so move it
                rowAdd = rowOUT + 1 - UBound(vOUT, 2)
                If rowAdd > 0 Then
                    ReDim Preserve vOUT(UBound(vOUT, 1), UBound(vOUT, 2) + rowAdd) As Variant
                End If

                rowOUT = rowOUT + 1
                vOUT(colOUT, rowOUT) = s
            'Else it is blank and skip that input cell
            End If

        Next rowIN
    Next colIN
    MsgBox (Ws.Name & "  vOUT + " & UBound(vOUT, 1) & " by " & UBound(vOUT, 2))

    With Ws
        .UsedRange.Clear
        .Range("A1").Resize(UBound(vOUT, 2), UBound(vOUT, 1)) = WorksheetFunction.Transpose(vOUT)
    End With



End Sub