VBA Copy data to last empty row results in 2 rows of data

Raakshaas 0
Viewed 39

I have a column of data on one sheet that I am transposing to the last row of another sheet. Since I need to cherry pick which cell goes to where I cannot use a transpose function so I wrote the following macro:

Sub Copy_to_empty_row_test()
  
  Dim cs As Worksheet 'Worksheet to copy from
  Dim ps As Worksheet 'Worksheet to copy to
  Set ps = Worksheets("Test")
  Set cs = Worksheets("Imports")

        ps.Range("A258:C258").Copy
        ps.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).PasteSpecial xlPasteFormulas

        'Date check
        cs.Range("B1").Copy
        ps.Cells(Rows.Count, 1).End(xlUp).Offset(1, 3).PasteSpecial xlPasteValues
        'OT
        cs.Range("B4").Copy
        ps.Cells(Rows.Count, 1).End(xlUp).Offset(1, 4).PasteSpecial xlPasteValues
    
        ThisWorkbook.Worksheets("Test").Range("I245").Copy
        ps.Cells(Rows.Count, 1).End(xlUp).Offset(1, 8).PasteSpecial xlPasteFormulas


End Sub

The issue I am running in to is that my data will copy to 2 rows instead of one row. So I will get one row with the formula and then a new row with the data. I have tried changing the code around, with this being the latest iteration, but I still end up with 2 rows of data instead of one.

Can anyone help with what I am missing?

Thanks.

vba excel
1 Answers

Copy Ranges

  • The issue is that when you copy the first cells, you are also copying to column A where you are doing the End(xlUp). So when doing it the second time the previous first available row in column A is occupied and the code copies the rest to the row below.
  • I have assumed that you are copying all cells from the copy worksheet. If that's not the case, as in your code, you can easily replace cws with pws in the first copying lines.
Sub CopyToEmptyRowTest()

    ' Reference the workbook ('wb').      
    Dim wb As Workbook: Set wb = ThisWorkbook ' workbook containing this code
    
    ' Reference the Copy worksheet ('cws').
    Dim cws As Worksheet: Set cws = wb.Worksheets("Imports")
    
    ' Reference the Paste worksheet ('pws').
    Dim pws As Worksheet: Set pws = wb.Worksheets("Test")

    ' Reference the first available cell ('pCell') in the Paste worksheet.
    Dim pCell As Range
    Set pCell = pws.Cells(pws.Rows.Count, "A").End(xlUp).Offset(1, 0)

    ' Copy.

    cws.Range("A258:C258").Copy
    pCell.PasteSpecial xlPasteFormulas

    'Date check
    cws.Range("B1").Copy
    pCell.Offset(0, 3).PasteSpecial xlPasteValues
    ' Alternatively, more efficient is copying values by assignment:
    'pCell.Offset(0, 3).Value = cws.Range("B1").Value
    
    'OT
    cws.Range("B4").Copy
    pCell.Offset(0, 4).PasteSpecial xlPasteValues
    ' Alternatively, more efficient is copying values by assignment:
    'pCell.Offset(0, 4).Value = cws.Range("B4").Value

    cws.Range("I245").Copy
    pCell.Offset(0, 8).PasteSpecial xlPasteFormulas

End Sub
VBasic20080
Related