I am trying to create price list from data in sheet Products and copy to sheet Price List with 2 rows of headers not the same and then have 2 blanks rows add to each for each rcell.
Each time I try to do this Headers get replaced even though they are not blank with the next and I cant seem to find how to add rows before the next for each rcell begins.
The below image is what I need. TIA
Each time I try to do this Headers get replaced even though they are not blank with the next and I cant seem to find how to add rows before the next for each rcell begins.
The below image is what I need. TIA
VBA Code:
Dim rCell As Range
Dim i As Long
Dim ws As Worksheet
'Set the variables
Set DataSh = ThisWorkbook.Sheets("Products")
Set PriceList = ThisWorkbook.Sheets("Price List")
Set CategoriesAA2 = DataSh.Range(DataSh.Cells(3, 1), DataSh.Cells(Rows.Count, 11).End(xlUp))
'I went from the cell row3/column6 (or F3) and go down until the last non empty cell
i = 2
For Each rCell In CategoriesAA2 'loop through each cell in the range
If rCell = "Play > Elevate, Play > Multi-Age Combinations, Play" Then
Worksheets("Price List").Cells(1).Resize(1, 5).Value = Array("Play > Elevate, Play > Multi-Age Combinations, Play")
Worksheets("Price List").Cells(1).Resize(1, 5).Value = Array("Code", "SKU", "Name", "Price", "Hyperlink to Web")
i = i + 1 'Row number
PriceList.Cells(i, 2) = rCell.Offset(0, -8)
PriceList.Cells(i, 3) = rCell.Offset(0, -7)
PriceList.Cells(i, 4) = rCell.Offset(0, -4)
PriceList.Cells(i, 5) = rCell.Offset(0, -3)
End If
Next rCell
For Each rCell In CategoriesAA2 'loop through each cell in the range
If rCell = "Fitness > Fitness Track"
Worksheets("Price List").Cells(1).Resize(1, 5).Value = Array("Fitness > Fitness Track")
Worksheets("Price List").Cells(1).Resize(1, 5).Value = Array("Code", "SKU", "Name", "Price", "Hyperlink to Web")
i = i + 1
PriceList.Cells(i, 2) = rCell.Offset(0, -8)
PriceList.Cells(i, 3) = rCell.Offset(0, -7)
PriceList.Cells(i, 4) = rCell.Offset(0, -4)
PriceList.Cells(i, 5) = rCell.Offset(0, -3)
End If
Next rCell
Worksheets("Price List").Activate
Range("D:D").HorizontalAlignment = xlRight
Range("C:C").HorizontalAlignment = xlLeft
Range("D:D").NumberFormat = "$#,##0.00"
Range("A:F").Font.Size = 10
Range("A:F").Font.Color = vbBlack
Range("A:F").Font.FontStyle = "Calibri Light"
End Sub