VBA copying data between sheets to irregular range - excel

Question

data set
Hi All,
I know its abasic stuff but trying to learn VBA and encountered this issue while building my first macro. I have completely no idea how to pull this through.
I have a data set in sheet1 - an array of 9 columns with headers (the range is not definite and will vary month to month) out of which I need to populate the data into a form in sheet2. The problem is that the form is just built manually across spreadsheet2. Someone just drew a table and adapted it as a form and it cannot be changed (just some requirement) Another thing is that table was created in a way where some cells are one above the other so 2 rows would contain the data of one in the source. I placed the photos that should paint the picture of what Im trying to say. So the only thing I knew is how to copy one row of data but have no idea how to loop it so that each next row from spread sheet1 will populate itself accordingly among these two other rows. So the idea is for the macro to copy data from the source and create necessary number of these double rows until the source data runs out(dependantly on how bit source range will be as its dynamic) At the end there must be that summary of TOtal from last row.
Ive tried it like this
Sub sbCopyRangeToAnotherSheet()
Dim wb As Workbook
Dim ws1 As Worksheet
Dim ws2 As Worksheet
ws1.Sheets("51").Range("H2").Copy
Sheets("Add 51").Range("A11").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Sheets("51").Range("C2").Copy
Sheets("Add 51").Range("B11").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Sheets("51").Range("E2").Copy
Sheets("Add 51").Range("D10").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Sheets("51").Range("F2").Copy
Sheets("Add 51").Range("D11").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Sheets("51").Range("D2").Copy
Sheets("Add 51").Range("E11").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Sheets("51").Range("I2").Copy
Sheets("Add 51").Range("I11").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
End Sub

Answer 1

Untested:
Sub Tester()
Dim rngDest As Range, rwSrc As Range, arr, i As Long
Set rwSrc = ThisWorkbook.Worksheets("51").Range("C2:H2") 'first row of source data
Set rngDest = ThisWorkbook.Worksheets("Add 51").Range("A5:I6") 'destination for first row
arr = Array("B2", "D2", "D1", "E1", "E2", "I2") 'array of *relative* addresses
Do While Application.CountA(rwSrc) > 0 'while there's any data in the source row
For i = 1 To rwSrc.Cells.Count 'loop over cells in source row
'set value of a cell in `rngDest` using relative range address from `arr`
rngDest.Range(arr(i - 1)).Value = rwSrc.Cells(i).Value 'i-1 because arr is zero-based
Next i
Set rwSrc = rwSrc.Offset(1) 'next source row
Set rngDest = rngDest.Offset(rngDest.Rows.Count) 'next destination block
Loop
End Sub
Relies on Range() being relative to the object it's called on, so for example
Range("B2:C4").Range("A1") is B2
Range("B2:C4").Range("B2") is C3