Copy Transpose Paste Vertically Breaking on Blanks

0

I am trying to copy/transpose/paste values from a one-column PivotTable and a formula column and I need it to paste vertically on another sheet and break on blanks. (see image) I need to copy each group in the PivotTable and formula column then transpose paste values vertically on a new worksheet. I believe I need to count populated rows (using an array?) until I get to a blank row then paste the group. I cannot figure out how to capture each group of populated rows to be pasted. I need it to break on each site NFID/FQNID then paste each group vertically.

With ThisWorkbook.Worksheets("FQNID_Sites")

    Dim lastRow As Long
    lastRow = .Cells(.Rows.Count, 4).End(xlUp).Row

    Dim i As Long
    For i = 2 To lastRow
        If Len(.Cells(i, 5)) = 0 Then
            Dim startTranspose As Range
            If startTranspose Is Nothing Then
                Set startTranspose = .Cells(i, 5)
            Else
                Set startTranspose = Union(startTranspose, .Cells(i, 5))
            End If
        End If
    Next

    Dim c As Range
    For Each c In startTranspose
        transposeData c
    Next

End With

Function transposeData(r As Range)

With ThisWorkbook.Worksheets("BH_FH")

    Dim nextRow As Long
    nextRow = .Cells(.Rows.Count, 3).End(xlUp).Row + 1

    Dim fullRange As Range
    Set fullRange = Range(r.Offset(1, -1), r.Offset(-1, 1))

    Dim arr As Variant
    arr = fullRange.Value

    .Cells(nextRow, 2).Value = r.Offset(0, -1).Value ' Add siteNFID
    .Cells(nextRow, 3).Resize(2, UBound(arr)).Value = Application.Transpose(arr)

End With

End Function

Example of the input and expected output format

Tom Hoover

Posted 2019-09-20T18:57:54.377

Reputation: 1

No answers