copying and pasting adjacent cell if the cell is not blank

[src16]

Hello,

I have two columns. Col A may have blank cells. I have a code which copies and pastes all data (minus blank cells) from Col A (from A2:A19) to the first blank cell of Column H. However, what I require is to only copy and paste those cells in Col A, whose adjacent cells in Col B are not blank. Right now, it's pasting all the data between rows 2 and 19 in Col A (minus any blank cells in col A) to Column H. I have no idea how to manipulate it to only paste those cells whose adjacent cell in col B is not blank. As I am new to VBA, any help is greatly appreciated!

'This loop checks for blank cells in Col A
For Each Cell In Range("A2:A19")
    If Cell.Text <> "" Then
        lrow = lrow + 1
     End If
    Next Cell

 With Worksheets("Database")
    lastRowColH = Range("H65536").End(xlUp).Row
           Range(Worksheets("Database").Cells(2, 1), Worksheets("Database").Cells(1 + lrow, 1)).Copy
        .Range("H" & lastRowColH + 1).PasteSpecial (xlPasteValues)
  End With
End Sub

[JOHN H. DAVIS]

Test on a copy first. See if this does what you want.

Change:

 With Worksheets("Database")
    lastRowColH = Range("H65536").End(xlUp).Row
           Range(Worksheets("Database").Cells(2, 1), Worksheets("Database").Cells(1 + lrow, 1)).Copy
        .Range("H" & lastRowColH + 1).PasteSpecial (xlPasteValues)
  End With

To this:

Worksheets("Database").Activate
    lastRowColH = Range("H65536").End(xlUp).Row
For Each CELL In Range(Worksheets("Database").Cells(2, 1), Worksheets("Database").Cells(1 + lrow, 1))
    If CELL.Value <> "" And CELL.Offset(, 1).Value <> "" Then
    
        CELL.Copy
        Range("H" & lastRowColH + 1).PasteSpecial (xlPasteValues)
    End If
Next CELL

[src16]

Hey, thanks for the speedy reply. Okay, I tested it upon a sample spreadsheet, and it does something strange...although the correct cells get copied (as in only the cells that have values in the adjacent cell), it gets pasted to the same cell and basically override each other. As in when I click the button, basically in the first blank cell of Column H, the correct cell gets copied and pasted, and then the next correct cell gets copied and pasted to the same cell instead of being pasted to the next blank cell of Column H. :S

[JOHN H. DAVIS]

OK maybe:

Worksheets("Database").Activate
    lastRowColH = Range("H65536").End(xlUp).Row
For Each CELL In Range(Worksheets("Database").Cells(2, 1), Worksheets("Database").Cells(1 + lrow, 1))
    If CELL.Value <> "" And CELL.Offset(, 1).Value <> "" Then
    
        CELL.Copy Range("H" & rows.count).End(3)(2)
        
    End If
Next CELL

[src16]

Hey,

For some reason, the code just isn't working. When I click the button, nothing happens. I have attached a sample worksheet. Basically, the the models under the Model columns change based on what radio button the user selects. If you can please take a look at your convenience, that would be great!