(Solved) – Copy/paste till last row VBA code doesn’t work when columns have less than 2 populated rows

  • by
(solved)-–-copy/paste-till-last-row-vba-code-doesn’t-work-when-columns-have-less-than-2-populated-rows

I’m rather new with VBA so please bear with me.

I’m trying to write a VBA code that helps me copy and paste data from multiple columns, into a single column on a different sheet.

My current code is able to copy data until the last filled row, and paste it after the last filled entry for each iteration. However, when a subsequent column is blank or has only 1 filled row, the code stops running completely. Can anyone help me figure out why this is the case please?

Sub FirstVBA()
Dim Criteria As Integer
Criteria = Range(“G1”).Value

If Criteria <> 0 Then
Worksheets(“Sheet2”).Range(“A2:A” & Rows.Count).Clear

     Worksheets("Sheet1").Range("B4", Range("B4").End(xlDown)).Copy
     Worksheets("Sheet2").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues

         Worksheets("Sheet1").Range("C4", Range("C4").End(xlDown)).Copy
     Worksheets("Sheet2").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues

       Worksheets("Sheet1").Range("D4", Range("D4").End(xlDown)).Copy
     Worksheets("Sheet2").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues

      Worksheets("Sheet1").Range("E4", Range("E4").End(xlDown)).Copy
     Worksheets("Sheet2").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues

    Worksheets("Sheet1").Range("F4", Range("F4").End(xlDown)).Copy
     Worksheets("Sheet2").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues

       Worksheets("Sheet1").Range("G4", Range("G4").End(xlDown)).Copy
     Worksheets("Sheet2").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues

       Worksheets("Sheet1").Range("H4", Range("H4").End(xlDown)).Copy
     Worksheets("Sheet2").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues

     Worksheets("Sheet1").Range("I4", Range("I4").End(xlDown)).Copy
     Worksheets("Sheet2").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues

End If

End Sub

Leave a Reply

Your email address will not be published. Required fields are marked *