Extract data to another sheet layout

[Goalexcel]

Hello Expert. Please kindly help to find out the best way ,maybe with VBA to extract data to another sheet layout report .
DataSheet1 no always has the same range A21 to N

Below the link to check the excel file Mar Pav sent you 1 item

 

[maabadi]

Hi.
First Interval rows is 6 row then 5 rows. Is it Correct? Are you can delete one row Between 9, 10, 12, 13 ?
And you want to Transfer Data from Sheet "Data" to "Layout" or Reverse?

 

[maabadi]

This will work with Same interval Between Data ( I supposed it is 5):
If you want also Border and Color for Cell, I shoula add them to code.

Sub TransformData()
Dim i As Long, j As Long, Lr1 As Long, Arr As Variant, F As Long, Lr2 As Long
Dim Sh1 As Worksheet, Sh2 As Worksheet, Nval As Variant
Set Sh1 = Sheets("Data")
Set Sh2 = Sheets("Layout")
'Set MyRange = Sh1.Range("A20:N21")
Lr1 = Sh1.Cells(Rows.Count, 1).End(xlUp).Row

For i = 1 To 14 Step 2
Sh2.Cells((i + 1) * 5 / 2, 1).Value = "Item 1"
Sh2.Cells((i + 1) * 5 / 2, 3).Value = "Description"
Sh2.Cells((i + 1) * 5 / 2, 5).Value = "Item 2"
Sh2.Cells((i + 1) * 5 / 2, 7).Value = "Description"
Sh2.Cells((i + 1) * 5 / 2 + 3, 1).Value = Sh1.Cells(20, i)
Sh2.Cells((i + 1) * 5 / 2 + 3, 3).Value = Sh1.Cells(21, i)
Sh2.Cells((i + 1) * 5 / 2 + 3, 5).Value = Sh1.Cells(20, i + 1)
Sh2.Cells((i + 1) * 5 / 2 + 3, 7).Value = Sh1.Cells(21, i + 1)
Next i

End Sub

 

[maabadi]

This is Colored Version with 5 rows Intervals:

Sub TransformData()
Dim i As Long, j As Long, Lr1 As Long, Arr As Variant, F As Long, Lr2 As Long
Dim Sh1 As Worksheet, Sh2 As Worksheet, Nval As Variant
Set Sh1 = Sheets("Data")
Set Sh2 = Sheets("Layout")
'Set MyRange = Sh1.Range("A20:N21")
Lr1 = Sh1.Cells(Rows.Count, 1).End(xlUp).Row

For i = 1 To 14 Step 2
Sh2.Cells((i + 1) * 5 / 2, 1).Value = "Item 1"
Sh2.Cells((i + 1) * 5 / 2, 3).Value = "Description"
Sh2.Cells((i + 1) * 5 / 2, 5).Value = "Item 2"
Sh2.Cells((i + 1) * 5 / 2, 7).Value = "Description"
Range(Sh2.Cells((i + 1) * 5 / 2 + 3, 1), Sh2.Cells((i + 1) * 5 / 2 + 3, 7)).Borders(xlEdgeTop).Weight = 3
Range(Sh2.Cells((i + 1) * 5 / 2 + 3, 1), Sh2.Cells((i + 1) * 5 / 2 + 3, 7)).Borders(xlEdgeBottom).Weight = 3
Sh2.Cells((i + 1) * 5 / 2 + 3, 3).Borders(xlEdgeRight).Weight = 3
Sh2.Cells((i + 1) * 5 / 2 + 3, 7).Borders(xlEdgeRight).Weight = 3
Sh2.Cells((i + 1) * 5 / 2 + 3, 1).Borders(xlEdgeLeft).Weight = 3
Sh2.Cells((i + 1) * 5 / 2 + 3, 1).Interior.ColorIndex = 6
Sh2.Cells((i + 1) * 5 / 2 + 3, 3).Interior.ColorIndex = 6
Sh2.Cells((i + 1) * 5 / 2 + 3, 5).Interior.ColorIndex = 6
Sh2.Cells((i + 1) * 5 / 2 + 3, 7).Interior.ColorIndex = 6
Sh2.Cells((i + 1) * 5 / 2 + 3, 1).Value = Sh1.Cells(20, i)
Sh2.Cells((i + 1) * 5 / 2 + 3, 3).Value = Sh1.Cells(21, i)
Sh2.Cells((i + 1) * 5 / 2 + 3, 5).Value = Sh1.Cells(20, i + 1)
Sh2.Cells((i + 1) * 5 / 2 + 3, 7).Value = Sh1.Cells(21, i + 1)
Next i

End Sub

 

[Goalexcel]

Hello Expert. Please find below the new file link Mar Pav sent you 1 item.
from sheet data copy to sheet layout .
DataSheet no always has the same range A to N. No need borders or color cell , I have the already the layout.

 

[Goalexcel]

Hi.
First Interval rows is 6 row then 5 rows. Is it Correct? Are you can delete one row Between 9, 10, 12, 13 ?
And you want to Transfer Data from Sheet "Data" to "Layout" or Reverse?

Hello , Please see new file link Mar Pav sent you 1 item

Transfer from sheet data to sheet layout

I have the layout report, I can't delete any row. No need borders or color yellow is only reference where to copy the data.

 

[Goalexcel]

This will work with Same interval Between Data ( I supposed it is 5):
If you want also Border and Color for Cell, I shoula add them to code.

Sub TransformData()
Dim i As Long, j As Long, Lr1 As Long, Arr As Variant, F As Long, Lr2 As Long
Dim Sh1 As Worksheet, Sh2 As Worksheet, Nval As Variant
Set Sh1 = Sheets("Data")
Set Sh2 = Sheets("Layout")
'Set MyRange = Sh1.Range("A20:N21")
Lr1 = Sh1.Cells(Rows.Count, 1).End(xlUp).Row

For i = 1 To 14 Step 2
Sh2.Cells((i + 1) * 5 / 2, 1).Value = "Item 1"
Sh2.Cells((i + 1) * 5 / 2, 3).Value = "Description"
Sh2.Cells((i + 1) * 5 / 2, 5).Value = "Item 2"
Sh2.Cells((i + 1) * 5 / 2, 7).Value = "Description"
Sh2.Cells((i + 1) * 5 / 2 + 3, 1).Value = Sh1.Cells(20, i)
Sh2.Cells((i + 1) * 5 / 2 + 3, 3).Value = Sh1.Cells(21, i)
Sh2.Cells((i + 1) * 5 / 2 + 3, 5).Value = Sh1.Cells(20, i + 1)
Sh2.Cells((i + 1) * 5 / 2 + 3, 7).Value = Sh1.Cells(21, i + 1)
Next i

End Sub

Hi, Please kindly no need to repeat item,description, because I have already the layout, only copy sheet1 data the numbers. Thank you

 

[maabadi]

Try this:

Sub TransformData()
Dim i As Long, j As Long, Lr1 As Long, Arr As Variant, F As Long, Lr2 As Long
Dim Sh1 As Worksheet, Sh2 As Worksheet, Nval As Variant
Set Sh1 = Sheets("Data")
Set Sh2 = Sheets("Layout")
Lr1 = Sh1.Cells(Rows.Count, 1).End(xlUp).Row

i = 1
Sh2.Cells((i + 1) * 5 / 2 + 2, 1).Value = Sh1.Cells(20, i)
Sh2.Cells((i + 1) * 5 / 2 + 2, 3).Value = Sh1.Cells(21, i)
Sh2.Cells((i + 1) * 5 / 2 + 2, 5).Value = Sh1.Cells(20, i + 1)
Sh2.Cells((i + 1) * 5 / 2 + 2, 7).Value = Sh1.Cells(21, i + 1)


For i = 3 To 14 Step 2
Sh2.Cells((i + 1) * 6 / 2 + 1, 1).Value = Sh1.Cells(20, i)
Sh2.Cells((i + 1) * 6 / 2 + 1, 3).Value = Sh1.Cells(21, i)
Sh2.Cells((i + 1) * 6 / 2 + 1, 5).Value = Sh1.Cells(20, i + 1)
Sh2.Cells((i + 1) * 6 / 2 + 1, 7).Value = Sh1.Cells(21, i + 1)
Next i

End Sub

 

[Goalexcel]

Try this:

Sub TransformData()
Dim i As Long, j As Long, Lr1 As Long, Arr As Variant, F As Long, Lr2 As Long
Dim Sh1 As Worksheet, Sh2 As Worksheet, Nval As Variant
Set Sh1 = Sheets("Data")
Set Sh2 = Sheets("Layout")
Lr1 = Sh1.Cells(Rows.Count, 1).End(xlUp).Row

i = 1
Sh2.Cells((i + 1) * 5 / 2 + 2, 1).Value = Sh1.Cells(20, i)
Sh2.Cells((i + 1) * 5 / 2 + 2, 3).Value = Sh1.Cells(21, i)
Sh2.Cells((i + 1) * 5 / 2 + 2, 5).Value = Sh1.Cells(20, i + 1)
Sh2.Cells((i + 1) * 5 / 2 + 2, 7).Value = Sh1.Cells(21, i + 1)


For i = 3 To 14 Step 2
Sh2.Cells((i + 1) * 6 / 2 + 1, 1).Value = Sh1.Cells(20, i)
Sh2.Cells((i + 1) * 6 / 2 + 1, 3).Value = Sh1.Cells(21, i)
Sh2.Cells((i + 1) * 6 / 2 + 1, 5).Value = Sh1.Cells(20, i + 1)
Sh2.Cells((i + 1) * 6 / 2 + 1, 7).Value = Sh1.Cells(21, i + 1)
Next i

End Sub

#SOLVE
Thank you very much for your help, outstanding support.
Can you please, explain me, step 1 and step 2, just only for reference, if I need to apply this macro to different layout.

 

[maabadi]

Step 2 means add 2 to i value for each next round. if you don't write Step it means step 1
Also we can you is with step -1 when we want to go from end of range to top of range (specially when we delete rows and row numbers decreased).