VBA to paste 1 thing multiple times

[jondavis1987]

Option Explicit
 
Sub Open_Workbook()
 
    Dim srcWB As Workbook
    Dim destWB As Workbook
    Dim fName As String
    Dim lastRow As Long
   
'   Capture current workbook as source workbook
    Set srcWB = ActiveWorkbook
 
'   Open destination workbook and capture it as destination workbook
    Workbooks.Open "C:\Users\jdavis\Dropbox\Quality Control\Aggregates\Recycled Concrete\Ag Base Yearly Chart.xlsx"
    Set destWB = ActiveWorkbook
   
'   Find last row of Sieve data in destination workbook
    lastRow = destWB.Sheets("Sieves").Cells(Rows.Count, "A").End(xlUp).Row + 1
   
'   Copy Sieve data from source workbook to destination workbook
    srcWB.Sheets("Sheet2").Range("J18:J25").Copy
    destWB.Sheets("Sieves").Range("A" & lastRow).PasteSpecial xlPasteValues
    srcWB.Sheets("A").Range("G29:G36").Copy
    destWB.Sheets("Sieves").Range("A" & lastRow).PasteSpecial xlPasteValues
    srcWB.Sheets("A").Range("H39:H46").Copy
    destWB.Sheets("Sieves").Range("B" & lastRow).PasteSpecial xlPasteValues
    srcWB.Sheets("A").Range("F39:F46").Copy
    destWB.Sheets("Sieves").Range("C" & lastRow).PasteSpecial xlPasteValues
    srcWB.Sheets("A").Range("F29:F36").Copy
    destWB.Sheets("Sieves").Range("D" & lastRow).PasteSpecial xlPasteValues
    srcWB.Sheets("A").Range("H29:H36").Copy
    destWB.Sheets("Sieves").Range("E" & lastRow).PasteSpecial xlPasteValues
    srcWB.Sheets("A").Range("A10:A17").Copy
    destWB.Sheets("Sieves").Range("F" & lastRow).PasteSpecial xlPasteValues
    srcWB.Sheets("A").Range("G21:G28").Copy
    destWB.Sheets("Sieves").Range("H" & lastRow).PasteSpecial xlPasteValues
    srcWB.Sheets("A").Range("H21:H28").Copy
    destWB.Sheets("Sieves").Range("I" & lastRow).PasteSpecial xlPasteValues
 
'   Find last row of AC data in destination workbook
    lastRow = destWB.Sheets("AC").Cells(Rows.Count, "A").End(xlUp).Row + 1
   
'   Copy AC data from source workbook to destination workbook
    srcWB.Sheets("A").Range("G29").Copy
    destWB.Sheets("AC").Range("A" & lastRow).PasteSpecial xlPasteValues
    srcWB.Sheets("A").Range("H39").Copy
    destWB.Sheets("AC").Range("B" & lastRow).PasteSpecial xlPasteValues
    srcWB.Sheets("A").Range("F39").Copy
    destWB.Sheets("AC").Range("C" & lastRow).PasteSpecial xlPasteValues
    srcWB.Sheets("A").Range("F29").Copy
    destWB.Sheets("AC").Range("D" & lastRow).PasteSpecial xlPasteValues
    srcWB.Sheets("A").Range("H37").Copy
    destWB.Sheets("AC").Range("E" & lastRow).PasteSpecial xlPasteValues
    srcWB.Sheets("A").Range("D18").Copy
    destWB.Sheets("AC").Range("F" & lastRow).PasteSpecial xlPasteValues
    srcWB.Sheets("A").Range("G47").Copy
    destWB.Sheets("AC").Range("G" & lastRow).PasteSpecial xlPasteValues
    srcWB.Sheets("A").Range("H47").Copy
    destWB.Sheets("AC").Range("H" & lastRow).PasteSpecial xlPasteValues
 
'   Find last row of Voids data in desitnation workbook
    lastRow = destWB.Sheets("Voids").Cells(Rows.Count, "A").End(xlUp).Row + 1
   
'   Copy Voids data from source workbook to destination workbook
    srcWB.Sheets("A").Range("G29").Copy
    destWB.Sheets("Voids").Range("A" & lastRow).PasteSpecial xlPasteValues
    srcWB.Sheets("A").Range("H39").Copy
    destWB.Sheets("Voids").Range("B" & lastRow).PasteSpecial xlPasteValues
    srcWB.Sheets("A").Range("F39").Copy
    destWB.Sheets("Voids").Range("C" & lastRow).PasteSpecial xlPasteValues
    srcWB.Sheets("A").Range("F29").Copy
    destWB.Sheets("Voids").Range("D" & lastRow).PasteSpecial xlPasteValues
    srcWB.Sheets("A").Range("H38").Copy
    destWB.Sheets("Voids").Range("E" & lastRow).PasteSpecial xlPasteValues
    srcWB.Sheets("A").Range("C48").Copy
    destWB.Sheets("Voids").Range("F" & lastRow).PasteSpecial xlPasteValues
    srcWB.Sheets("A").Range("G48").Copy
    destWB.Sheets("Voids").Range("G" & lastRow).PasteSpecial xlPasteValues
    srcWB.Sheets("A").Range("H48").Copy
    destWB.Sheets("Voids").Range("H" & lastRow).PasteSpecial xlPasteValues
   
'   Save changes and close destination workbook
    destWB.Close SaveChanges:=True
 
'   Export source workbook to PDF
    With srcWB
        fName = Range("A!F19").Value
        ActiveWorkbook.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
            "C:\Users\jdavis\Dropbox\Quality Control\Asphalt\Asphalt Reports\" & fName, Quality:=xlQualityStandard, _
            IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=True
    End With
 
End Sub

If I need C48 of sheet "A" in the source workbook to paste 8 times in the destination workbook how would I go about doing that?

srcWB.Sheets("A").Range("C48").Copy
    destWB.Sheets("Voids").Range("F" & lastRow).PasteSpecial xlPasteValues

 

[gallen]

Firstly remove the +1. So change

[COLOR=#333333]lastRow = destWB.Sheets("Voids").Cells(Rows.Count, "A").End(xlUp).Row + 1[/COLOR]

to

[COLOR=#333333]lastRow = destWB.Sheets("Voids").Cells(Rows.Count, "A").End(xlUp).Row[/COLOR]

then to do it 8 times it would be something like:

    For i = 1 To 8
        destWB.Sheets("Voids").Range("F" & lastRow).Offset(i) = srcWB.Sheets("A").Range("C48")
    Next i