VBA code to copy and paste rows three times from one worksheet to another

Question

My idea is to get the data that I have on "A4" ("Data" worksheet) and paste it 4 times on "B4" ("Forecast" worksheet). After that, take the data from "A5" and do the same (starting from the first blank cell) until there is no more data on the "A" column. After there is no more data, the process should stop.

How do I tell excel to paste the value in the first blank cell in column B ("Forecast" worksheet)?

Sub Test()

    Dim wsSource As Worksheet, wsTarget As Worksheet
    Dim i As Integer, k As Integer
    
    Set wsSource = ThisWorkbook.Worksheets("Data")
    Set wsTarget = ThisWorkbook.Worksheets("Forecast")
    
    k = wsSource.Range("A4", wsSource.Range("A4").End(xlDown)).Rows.Count
    
    For i = 1 To k
    
        wsTarget.Range("B4", "B7").Value = wsSource.Range("A" & 3 + i).Value
        
    Next

End Sub

score 1 · Answer 1 · answered Feb 13 '22 at 05:05

Copy Repetitions

A Quick Fix

Sub Test()

    Dim wsSource As Worksheet, wsTarget As Worksheet
    Dim sCell As Range, tCell As Range
    Dim i As Long, j As Long, k As Long
    
    Set wsSource = ThisWorkbook.Worksheets("Data")
    Set wsTarget = ThisWorkbook.Worksheets("Forecast")
    
    k = wsSource.Range("A4", wsSource.Range("A4").End(xlDown)).Rows.Count
    
    Set sCell = wsSource.Range("A4")
    Set tCell = wsTarget.Range("B4")
       
    For i = 1 To k
        For j = 1 To 4
            tCell.Value = sCell.Value
            Set tCell = tCell.Offset(1)
        Next j
        Set sCell = sCell.Offset(1)
    Next i
        
End Sub

My Choice

Sub CopyRepetitions()
      
    ' Source
    Const sName As String = "Data"
    Const sfCellAddress As String = "A4"
    ' Destination
    Const dName As String = "Forecast"
    Const dfCellAddress As String = "B4"
    Const Repetitions As Long = 4
    ' Workbook
    Dim wb As Workbook: Set wb = ThisWorkbook ' workbook containing this code
    
    ' Reference the source (one-column) range ('srg').
    
    Dim sws As Worksheet: Set sws = wb.Worksheets(sName)
    
    Dim srg As Range
    Dim srCount As Long
    
    With sws.Range(sfCellAddress)
        Dim lCell As Range: Set lCell = .Resize(sws.Rows.Count - .Row + 1) _
            .Find("*", , xlFormulas, , , xlPrevious)
        If lCell Is Nothing Then Exit Sub ' no data
        srCount = lCell.Row - .Row + 1
        Set srg = .Resize(srCount)
    End With
    
    ' Write values from the source range the source array ('sData')
    
    Dim sData As Variant
    
    If srCount = 1 Then
        ReDim sData(1 To 1, 1 To 1): sData(1, 1) = srg.Value
    Else
        sData = srg.Value
    End If
    
    ' Define the destination array ('dData').
    
    Dim drCount As Long: drCount = srCount * Repetitions
    Dim dData As Variant: ReDim dData(1 To drCount, 1 To 1)
    
    ' Write the repeating values from the source- to the destination array.
    
    Dim sr As Long
    Dim rep As Long
    Dim dr As Long
    
    For sr = 1 To srCount
        For rep = 1 To Repetitions
            dr = dr + 1
            dData(dr, 1) = sData(sr, 1)
        Next rep
    Next sr
    
    ' Write the values from the destination array to the destination
    ' one-column range and clear the data below.
    
    Dim dws As Worksheet: Set dws = wb.Worksheets(dName)
    With dws.Range(dfCellAddress)
        .Resize(drCount).Value = dData
        .Resize(dws.Rows.Count - .Row - drCount + 1).Offset(drCount).Clear
    End With
      
    ' Inform.
    MsgBox "Repetitions copied.", vbInformation

End Sub

Many thanks! Why do you use Long instead of Integer in this case? What's the main benefit of Long? — Claire Lin, Feb 13 '22 at 08:07
Nowadays integer is used very rarely. [Here](https://stackoverflow.com/a/26409520) is a post on the subject. — VBasic2008, Feb 13 '22 at 08:10

VBA code to copy and paste rows three times from one worksheet to another

1 Answers1

Copy Repetitions