Transpose and copy data every 23 lines with VBA loop!

[curtitoo]

Hello,

I am quite the noob when it comes to VBA and am using someone elses code to be somewhat modified to fit my needs (unsuccessfully).

Here's my situation. I have a pretty big file that i want *certain fields (unique ID's)* of the data within 1 row to be transposed into one column and that same row (excluding the just transposed data) to be copied 23 times (so 24 total because of the original one). So my goal here is to match up that redundant data of 24 rows with the Unique ID's. So in essance i want to create duplicate entries EXCEPT for the Unique ID's per every entry. I want to run this for every 24 rows as it represents a different entity every 24 rows. Thanks in advance and I will attach an example of what i mean.

Things to keep in mind:





I was thinking maybe something like this:


Sub test()
Dim lngLastRow As Long, lngLastCol As Long, lngLoopRow As Long, lngWriteRow As Long
Dim lngLoopCol As Long, wsWriteSheet As Worksheet
Set wsWriteSheet = Sheets("Sheet1")
'Starts transpose at line (look at the next line)
lngWriteRow = 2
With Sheets("Sheet1")
lngLastRow = .Range("A" & Rows.Count).End(xlUp).Row

For lngLoopRow = 1 To lngLastRow

lngLastCol = .Cells(lngLoopRow, Columns.Count).End(xlToLeft).Column

For lngLoopCol = 2 To lngLastCol

'wsWriteSheet.Range("A" & lngWriteRow) = .Cells(lngLoopRow, 1)
wsWriteSheet.Range("B" & lngWriteRow) = .Cells(lngLoopRow, lngLoopCol)
lngWriteRow = lngWriteRow + 1

Next lngLoopCol

Next lngLoopRow

End With
End Sub