Find cell & select/copy from active cell to last row including blanks

Question

I'm attempting to find a column using the column header name, then select all the data from the column (including the blank cells) & paste into another range.

Currently I can only copy until the 1st blank cell. I have seen similar problems on the board but the solutions I have seen are coming from the angle of knowing which column it is in first & then finding the last row from the bottom of the worksheet.

Workbooks("PS & Config - Actuals & FC.xlsm").Worksheets(2).Range("A3").CurrentRegion.Find(What:="FFA Name").Select
Range(ActiveCell, ActiveCell.End(xlDown)).Select
Range("A3").Select
ActiveSheet.Paste

Leif Leif · Accepted Answer · 2019-11-20T04:31:17

To find the column use Match wit the column header name. Once you have that column, set the values in the destination range to be the same as that column. Selecting, copying, and pasting in VBA are unnecessary as the values themselves can be moved--plus it adds load.

I don't have Office anymore so I'm running this from memory. I hope it helps.

dim wb as workbook, ws1, ws2 as worksheet, myCol, myRow as long

set wb=excel.thisworkbook 'assuming this code goes in that workbook
set ws1=wb.sheets(2) 'set variables

myCol=worksheetfunction.match("FFA Name",ws1.[a1:zz1],0) 'search through 1st row
myRow=ws1.[a3].currentregion.rows.count 'grab last row containing data in this set

'do not select, nor copy and paste, if it can all be done with VBA. This can.

set ws2=wb.sheets.add 'a little rusty on this line, you can get the method from the macro recorder
ws2.cells(1,1).resize(myrow).value=ws1.cells(1,myCol).resize(myrow).value

The reason your original code stops when there's a blank cell is because the .end() method simulates pushing the end key and then an arrow, which goes to the first/last contiguous cell with data. Range(ActiveCell, ActiveCell.End(xlDown)).Select

Find cell & select/copy from active cell to last row including blanks

1 Answers