Tom Hoover
09-18-2019, 02:20 PM
I am trying to copy/transpose/paste values from a one-column PivotTable and another column with a formula. I need it to paste vertically on another sheet and break on blank cells. (see image) I need to copy each group then paste each group 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 can picture what I need to do but all my coding attempts are way off. I cannot figure out how to capture each group of populated rows to be pasted. The code below sort of works, maybe it can be tweaked? I am stuck hard and really need some assistance!
With ThisWorkbook.Workseets("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 startTanspose
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(1).Value
.Cells(nextRow, 3).Resize(2, UBound(arr)).Value = Application.Transpose(arr)
End With
End Function
I need it to break on each siteNFID then paste each group vertically. An image of the input and expected output should be attached.
With ThisWorkbook.Workseets("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 startTanspose
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(1).Value
.Cells(nextRow, 3).Resize(2, UBound(arr)).Value = Application.Transpose(arr)
End With
End Function
I need it to break on each siteNFID then paste each group vertically. An image of the input and expected output should be attached.