(VBA) How to move data from one sheet to another, moving down and across rows to pull data

Question

I am looking to get some help moving data from one sheet to another in VBA. I have attached screenshots of the source data sheet as well as the destination data sheet, to make things easier to visualize.

I need:

1. Sheet2 to display the employees name (from cell C3) under the employee column
2. the Pay period (from column A) under the PP column
3. the data (from column B) under the production date column
4. the activity performed (from columns E-H) under the task ID column
5. and the number of each activities they performed under the How many? column.

All of the activities with 0 under them do not need a row, I only need new rows for activities with a certain number actually completed.

The other data from the source sheet can be ignored.

The only activities that I need data for are Mopping, Cleaning, Scrubbing, and Wiping.

I did a few lines manually as an example, but would love to figure out a way to automate the process, as I have hundreds of similar production sheets.

I tried to write the code myself (attached), but it's messy and does not seem to get the job done correctly:( Any help or tips would be greatly appreciated :)

Source data: Destination sheet:

Sub Report()
    Dim ws1 as worksheet
    Set ws1 = Sheets("Sheet1")

    Dim ws2 As Worksheet
    Set ws2 = Sheets("Sheet2")

    Dim i As Long
    Dim Roww As Long
    Dim NameRow As Long: NameRow = 1

    Sheets("Sheet2").Range("F2:F2000").Value = "Regular Hours"

    For i = 1 To ws1.Cells(ws1.Rows.Count, "A").End(xlUp).Row
        If InStr(ws1.Cells(i, "A").Value2, "PP") > 0 Then

            Roww = ws2.Cells(ws2.Rows.Count, "A").End(xlUp).Offset(1, 0).Row

        If Not IsError(ws1.Cells(i, "D")) Then
                ws2.Cells(Roww, "A").Value2 = ws1.Cells(i, "A").Value2
                ws2.Cells(Roww, "B").Value2 = ws1.Cells(NameRow, "B").Value2

                ws2.Cells(Roww, "C").Value2 = ws1.Cells(3, "B").Value2
                ws2.Cells(Roww, "E").Value2 = ws1.Cells(i, "C").Value2
                ws2.Cells(Roww, "F").Value2 = ws1.Cells(i, "B").Value2


                ws2.Cells(Roww, "I").Value2 = ws1.Cells(NameRow, "L").Value2

                Roww = Roww + 1

            End If
        If Not IsError(ws1.Cells(i, "G")) Then
                ws2.Cells(Roww, "A").Value2 = ws1.Cells(i, "A").Value2
                ws2.Cells(Roww, "B").Value2 = ws1.Cells(NameRow, "B").Value2


                ws2.Cells(Roww, "C").Value2 = ws1.Cells(3, "E").Value2
                ws2.Cells(Roww, "E").Value2 = ws1.Cells(i, "F").Value2
                ws2.Cells(Roww, "F").Value2 = ws1.Cells(i, "E").Value2

                ws2.Cells(Roww, "I").Value2 = ws1.Cells(NameRow, "L").Value2

                Roww = Roww + 1

            End If
        If Not IsError(ws1.Cells(i, "J")) Then
                ws2.Cells(Roww, "A").Value2 = ws1.Cells(i, "A").Value2
                ws2.Cells(Roww, "B").Value2 = ws1.Cells(NameRow, "B").Value2

                ws2.Cells(Roww, "C").Value2 = ws1.Cells(3, "H").Value2
                ws2.Cells(Roww, "E").Value2 = ws1.Cells(i, "I").Value2
                ws2.Cells(Roww, "F").Value2 = ws1.Cells(i, "H").Value2


                ws2.Cells(Roww, "I").Value2 = ws1.Cells(NameRow, "L").Value2

                Roww = Roww + 1

            End If
        If Not IsError(ws1.Cells(i, "M")) Then


                ws2.Cells(Roww, "A").Value2 = ws1.Cells(i, "A").Value2
                ws2.Cells(Roww, "B").Value2 = ws1.Cells(NameRow, "B").Value2


                ws2.Cells(Roww, "C").Value2 = ws1.Cells(3, "K").Value2
                ws2.Cells(Roww, "E").Value2 = ws1.Cells(i, "L").Value2
                ws2.Cells(Roww, "F").Value2 = ws1.Cells(i, "K").Value2


                ws2.Cells(Roww, "I").Value2 = ws1.Cells(NameRow, "L").Value2

                Roww = Roww + 1

            End If
        If Len(ws1.Cells(i, "N")) > 0 Then

                ws2.Cells(Roww, "A").Value2 = ws1.Cells(i, "A").Value2
                ws2.Cells(Roww, "B").Value2 = ws1.Cells(NameRow, "B").Value2

                ws2.Cells(Roww, "C").Value2 = ws1.Cells(3, "N").Value2
                ws2.Cells(Roww, "F").Value2 = ws1.Cells(i, "N").Value2


                ws2.Cells(Roww, "I").Value2 = ws1.Cells(NameRow, "L").Value2

                Roww = Roww + 1

            End If
        If Len(ws1.Cells(i, "O")) > 0 Then


                ws2.Cells(Roww, "A").Value2 = ws1.Cells(i, "A").Value2
                ws2.Cells(Roww, "B").Value2 = ws1.Cells(NameRow, "B").Value2

                ws2.Cells(Roww, "C").Value2 = ws1.Cells(3, "O").Value2
                ws2.Cells(Roww, "F").Value2 = ws1.Cells(i, "O").Value2

                ws2.Cells(Roww, "I").Value2 = ws1.Cells(NameRow, "L").Value2

                Roww = Roww + 1

            End If
        If Len(ws1.Cells(i, "P")) > 0 Then

                'period, name
                ws2.Cells(Roww, "A").Value2 = ws1.Cells(i, "A").Value2
                ws2.Cells(Roww, "B").Value2 = ws1.Cells(NameRow, "B").Value2

                'type, hours
                ws2.Cells(Roww, "C").Value2 = ws1.Cells(3, "P").Value2
                ws2.Cells(Roww, "F").Value2 = ws1.Cells(i, "P").Value2

                'year
                ws2.Cells(Roww, "I").Value2 = ws1.Cells(NameRow, "L").Value2

                Roww = Roww + 1

            End If
        If Len(ws1.Cells(i, "Q")) > 0 Then


                ws2.Cells(Roww, "A").Value2 = ws1.Cells(i, "A").Value2
                ws2.Cells(Roww, "B").Value2 = ws1.Cells(NameRow, "B").Value2

                ws2.Cells(Roww, "C").Value2 = ws1.Cells(3, "Q").Value2
                ws2.Cells(Roww, "F").Value2 = ws1.Cells(i, "Q").Value2


                ws2.Cells(Roww, "I").Value2 = ws1.Cells(NameRow, "L").Value2

                Roww = Roww + 1

            End If

        ElseIf InStr(ws1.Cells(i, "A").Value2, "Name") > 0 Then
            NameRow = i
        End If

    Next i
End Sub

Answer 1

I didn't include everything, as you seem to know how to get your data ranges already, so I left them with my test values. Also didn't include all the fields you were passing over as you seem to have a handle on that.

Main difference is the scanning the header row for your names. What the code does is loops through your source worksheet rows, and also loops through the column data. It uses your the oHeaderRow value to identify the task, and associates it to the value of the current row we're on.

Sub Test()
    Dim ws1 As Worksheet
    Set ws1 = Sheets("Sheet1")

    Dim ws2 As Worksheet
    Set ws2 = Sheets("Sheet2")

    Dim oHeaderRow As Long
    Dim oCurRow, oCurCol As Long
    Dim oDestRow As Long

    oHeaderRow = 4      ' Which Row your Source Header is on
    oDestRow = 2        ' Destination Start Row

    For oCurRow = 5 To 8        ' Can manipulate these (you already seem to know how)
        For oCurCol = 5 To 8    ' Columns to scan for headers & Data
            If Not IsEmpty(ws1.Cells(oCurRow, oCurCol)) Then
                If ws1.Cells(oCurRow, oCurCol) > 0 Then
                    ws2.Cells(oDestRow, "B") = ws1.Cells(3, 3)  ' Name
                    ' Other Fields...
                    ws2.Cells(oDestRow, "E") = ws1.Cells(oHeaderRow, oCurCol)   ' get Header Name
                    ws2.Cells(oDestRow, "F") = ws1.Cells(oCurRow, oCurCol)      ' get Value
                    oDestRow = oDestRow + 1
                End If
            End If
        Next
    Next
End Sub

Answer 2

Not sure why you're filling column F with "Regular Hours".

As far as efficiency goes, there are enough repetitive actions in your situation that you can break out the "saving" of your data to the destination sheet in a separate function. Below is an example on how to simplify some of the logic in your situation. Clearly, you need to modify it to fit your exact needs.

Option Explicit

Sub Report()
    Dim srcWS As Worksheet
    Dim dstWS As Worksheet
    Set srcWS = ThisWorkbook.Sheets("Sheet1")
    Set dstWS = ThisWorkbook.Sheets("Sheet2")

    Dim taskIDs() As String
    taskIDs = Split("Mopping,Cleaning,Scrubbing,Wiping", ",")

    Dim lastSrcRow As Long
    lastSrcRow = srcWS.Cells(srcWS.Rows.Count, 1).End(xlUp).Row

    Dim lastDstRow As Long
    lastDstRow = 2

    Dim employeeName As String
    employeeName = srcWS.Range("C3")

    Dim i As Long
    For i = 7 To lastSrcRow
        If Left(srcWS.Cells(i, 1), 2) = "PP" Then
            Dim pp As String
            Dim prodDate As Date
            pp = srcWS.Cells(i, 1)
            prodDate = srcWS.Cells(i, 2)
            Dim j As Long
            For j = 5 To 8
                lastDstRow = SaveNextData(dstWS, employeeName, pp, prodDate, _
                                        taskIDs(j - 5), srcWS.Cells(i, j), lastDstRow)
            Next j
        End If
    Next i
End Sub

Private Function SaveNextData(ByRef dstWS As Worksheet, _
                              ByVal empName As String, _
                              ByVal payPeriod As String, _
                              ByVal prodDate As Date, _
                              ByVal taskID As String, _
                              ByVal value As Variant, _
                              ByVal rowNum As Long) As Long
    '--- if the given value is not zero, this function copies the given
    '    data to the destination worksheet and returns the next row number
    If value > 0 Then
        dstWS.Cells(rowNum, 2) = empName
        dstWS.Cells(rowNum, 3) = payPeriod
        dstWS.Cells(rowNum, 4) = Format(prodDate, "mm/dd/yyyy")
        dstWS.Cells(rowNum, 5) = taskID
        dstWS.Cells(rowNum, 6) = vbNullString   'time type?
        dstWS.Cells(rowNum, 7) = value
        SaveNextData = rowNum + 1
    Else
        SaveNextData = rowNum
    End If
End Function