Copy till first non-blank row and paste on first blank row

[patsdavixen]

I'm working on this macro that copies data on sheet1 from A2:AI2 till the last non-blank row in the same range i.e. A:AI and paste it on sheet2 in the first blank row. However, my code keeps picking up A1:AI1 from sheet1 as well and pastes it on sheet2 just before the data that I actually want to paste. Here's my code:

Sub Copy()
    Range("A2").Select
    lastCol = ActiveSheet.Range("A2:AI2").End(xlToRight).Column
    lastrow = ActiveSheet.Cells(65536, lastCol).End(xlUp).Row
    ActiveSheet.Range("A2:AI2", ActiveSheet.Cells(lastrow, lastCol)).Copy
    ActiveSheet.Next.Select
    If Application.WorksheetFunction.CountA("A:A") = 0 Then
    [A1].Select
    Else
    On Error Resume Next
    Columns(1).SpecialCells(xlCellTypeBlanks)(1, 1).Select
    If Err <> 0 Then
    On Error GoTo 0
    [A65536].End(xlUp)(2, 1).Select
    End If
    On Error GoTo 0
    End If
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    End Sub

Please help me fix it

Thanks,
Pat

 

[kevatarvind]

but in this where you facing problem ?

what is not going on proper way ?

 

[patsdavixen]

Hi kevatarvind,

The problem is that the macro should copy only from A2:AI2 downwards. It should not capture A1:AI1.. The range is variable but Row 1 will never be a part of the range as it is a header in my worksheet.

 

[Jerry Sullivan]

Hi Pat,

Here's some code you can try.

Sub MyCopy()
    Dim lastCol As Long, lastRow As Long

    
    With Sheets("Sheet1")
        lastCol = .Cells(2, .Columns.Count).End(xlToLeft).Column
        lastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
        .Range("A2", .Cells(lastRow, lastCol)).Copy
    End With

    
    With Sheets("Sheet2")
        lastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
        If lastRow = 1 And .Cells(1) = "" Then lastRow = 0
        .Cells(lastRow + 1, "A").PasteSpecial Paste:=xlPasteValues, _
            Operation:=xlNone, SkipBlanks:=False, Transpose:=False
    End With

    Application.CutCopyMode = False
End Sub

 

[patsdavixen]

Hi Jerry,

Your code works perfectly!!
You are a life saver.. Thanks a ton