excelvba

vba Paste data multiple times into another sheet

I'm tying to create a price list of our products to import into our system. My source data has the item code and base cost.

Desired output

Example of the output. There are more levels than pictured

I'm trying to use vba but my output only does the first entry. Below is the output I'm getting. enter image description here

My code is below:

    Sub PriceCopy()
    Dim wsSource As Worksheet, wsTarget As Worksheet
    Dim Lastrows As Long, LastrowT As Long, i As Long
    Dim ItemCode As String
    Dim Price As Double
        
    Set wsSource = ThisWorkbook.Worksheets("Sheet6")
    Set wsTarget = ThisWorkbook.Worksheets("Sheet5")
        
    Lastrows = wsSource.Cells(wsSource.Rows.Count, "A").End(xlUp).Row
    FirstRow = 1
    
    For i = 1 To Lastrows
    
    ItemCode = wsSource.Range("A" & i).Value
    Price = wsSource.Range("C" & i).Value
    
    wsTarget.Range("A" & FirstRow).Value = ItemCode
    wsTarget.Range("A" & FirstRow + 1).Value = ItemCode
    wsTarget.Range("A" & FirstRow + 2).Value = ItemCode
    wsTarget.Range("A" & FirstRow + 3).Value = ItemCode

    wsTarget.Range("B" & FirstRow).Value = 1
    wsTarget.Range("B" & FirstRow + 1).Value = 2
    wsTarget.Range("B" & FirstRow + 2).Value = 3
    wsTarget.Range("B" & FirstRow + 3).Value = 4

    wsTarget.Range("C" & FirstRow).Value = Price + 1
    wsTarget.Range("C" & FirstRow + 1).Value = Price + 1.1
    wsTarget.Range("C" & FirstRow + 2).Value = Price + 1.2
    wsTarget.Range("C" & FirstRow + 3).Value = Price + 1.3

    LastRow = wsTarget.Cells(wsTarget.Rows.Count, "A").End(xlUp).Row
    
    Next i
    End Sub

Is it something in my For loop? Any help would be appreciated.

Solution

  • FirstRow refers to the row number where the output will be written. It should be incremented after each row is written.

    Sub PriceCopy()
    Dim wsSource As Worksheet, wsTarget As Worksheet
    Dim Lastrows As Long, LastrowT As Long, i As Long
    Dim ItemCode As String
    Dim Price As Double
    Set wsSource = ThisWorkbook.Worksheets("Sheet6")
    Set wsTarget = ThisWorkbook.Worksheets("Sheet5")
    ' get the first blank row on wsTarge col A
    If Len(wsTarget.Cells(1, "A"))=0 Then
        FirstRow = 1
    Else
        FirstRow = wsTarget.Cells(wsTarget.Rows.Count, "A").End(xlUp).Row + 1
    End If
    ' get the last data row# of wsSource
    Lastrows = wsSource.Cells(wsSource.Rows.Count, "A").End(xlUp).Row
    For i = 1 To Lastrows
        ItemCode = wsSource.Range("A" & i).Value
        Price = wsSource.Range("C" & i).Value
        ' write Four item code all at once
        wsTarget.Range("A" & FirstRow).Resize(4,1).Value = ItemCode
        wsTarget.Range("B" & FirstRow).Value = 1
        wsTarget.Range("B" & FirstRow + 1).Value = 2
        wsTarget.Range("B" & FirstRow + 2).Value = 3
        wsTarget.Range("B" & FirstRow + 3).Value = 4
        wsTarget.Range("C" & FirstRow).Value = Price + 1
        wsTarget.Range("C" & FirstRow + 1).Value = Price + 1.1
        wsTarget.Range("C" & FirstRow + 2).Value = Price + 1.2
        wsTarget.Range("C" & FirstRow + 3).Value = Price + 1.3
        FirstRow = FirstRow + 4
    Next i
End Sub