Microsoft Office Forums - View Single Post - [Solved] Copying and pasting values with unequal data columns

charlesdh · 12-05-2014, 11:36 AM

Hi,

Here's the code that I have. You can see if it works.
Copy to a module and test on sample data.

Code:

Sub Copy_PTData()
Application.ScreenUpdating = False
Dim i As Long
Dim LastRow As Long '' for column A lastrow
Dim Lrow As Long '' fo column E
LastRow = ActiveSheet.Range("A1").SpecialCells(xlCellTypeLastCell).Row
''' Clear the copy range for new input '''
ActiveSheet.Range("E2:F" & ActiveSheet.Range("E65536").End(xlUp).Row).ClearContents
For i = 5 To LastRow
    ''' get last last row of data in column E
    Lrow = ActiveSheet.Range("E65536").End(xlUp).Row + 1
    ''' now loop down column A and copy
    If Cells(i, 1).Text <> "" And Cells(i, 1).Text <> "(blank)" Then ''' not sure about this line
        Cells(Lrow, 5).Value = Cells(i, 1).Text
        Cells(Lrow, 6).Value = Cells(i, 3).Text
    Else '' column A is empty
        Cells(Lrow, 5).Value = Cells(i, 2).Text
        Cells(Lrow, 6).Value = Cells(i, 3).Text
    End If
    If i = LastRow Then
        Cells(Lrow, 6).Value = Cells(i, 3).Text
    End If
Next i
Application.ScreenUpdating = True
End Sub