Macro to copy data from various locations repeating down a list

[dc007c0231]

Morning all,

I need to produce a list from an imported PDF file in Excel. The list has multiple accounts on it showing what they have bought in a store. This results in some people having one line and some with 20 etc. I need all of this data in a clean list with all the relevant data added to the end columns. I have attached an image showing the template and what I need.

I need B10 copied to col U against each row of data (where there are transactions only), I need the blank cells under the dates populated with the date from above (only where there's a transaction) and the name and form as well (as per the colour coding). I could record a macro to do this for the first entry but I don't know how to repeat it down the entire sheet (8000 rows) which have different number of rows in each set of data.

Can anyone help please?
Thanks
James

 

[dc007c0231]

I have the answer now.

 

[Joe4]

I have the answer now.

Please post it here then.
It may help someone else in the future (and then you can mark that post as the solution!).

 

[dc007c0231]

Public Sub ShopRecharges()

Dim sId As String
Dim sName As String
Dim sForm As String
Dim tDate As Variant
Dim lRow As Long
Dim tRow As Long

lRow = Cells(Rows.Count, "S").End(xlUp).Row
For tRow = 1 To lRow
If Cells(tRow, "B").MergeArea.Rows.Count > 1 And Cells(tRow, "B").Value <> "" Then
sId = Cells(tRow, "B").Value
sName = Cells(tRow, "D").Value
sForm = Cells(tRow + 2, "D").Value
ElseIf Cells(tRow, "E").Value <> "" And Cells(tRow, "E").Value <> "Code" Then
If Cells(tRow, "B").Value = "" Then
With Cells(tRow, "B")
.Value = tDate
.Resize(1, 2).Merge
.HorizontalAlignment = xlLeft
End With
Else
tDate = Cells(tRow, "B").Value
End If
Cells(tRow, "U").Resize(1, 3).Value = Array(sId, sName, sForm)
End If
Next tRow

End Sub

 

[Joe4]

Thank you!