VB Code to reorganize payroll data as explained

Hey. Here's the code I wrote. I hope it's close to what you want:

Public Sub CopyEarnings()

Dim oneSheet As Worksheet
Dim twoSheet As Worksheet
Dim lastRow As Long
Dim thisRow As Long
Dim nextRow As Long
Dim checkRow As Long
Dim totalRow As Long
Dim loopRow As Long

Application.ScreenUpdating = False
Set oneSheet = Worksheets("Sheet1")
Set twoSheet = Worksheets("Sheet2")
lastRow = oneSheet.Cells(oneSheet.Rows.Count, "A").End(xlUp).Row
nextRow = 2
checkRow = 0
totalRow = 0
For thisRow = 1 To lastRow
    If Left(oneSheet.Cells(thisRow, "A").Value, 5) = "CHECK" Then checkRow = thisRow
    If Left(oneSheet.Cells(thisRow, "A").Value, 4) = "This" Then totalRow = thisRow
    If InStr(oneSheet.Cells(thisRow, "A").Value, ",") > 0 Then
        If checkRow > 0 And totalRow > 0 And (totalRow - checkRow) > 1 Then
            For loopRow = checkRow + 1 To totalRow - 1
                If oneSheet.Cells(loopRow, "A").Value <> "" Then
                    twoSheet.Cells(nextRow, "A").Value = oneSheet.Cells(thisRow, "A").Value
                    twoSheet.Cells(nextRow, "B").Value = oneSheet.Cells(loopRow, "A").Value
                    twoSheet.Cells(nextRow, "C").Value = oneSheet.Cells(loopRow, "B").Value
                    nextRow = nextRow + 1
                End If
            Next loopRow
        End If
        checkRow = 0
        totalRow = 0
    End If
Next thisRow
Application.ScreenUpdating = True

End Sub

WBD