Find a small amount of data amongst a lot of empty cells

[spill-the-beans]

Hello everyone,

One of my datasheets by necessity ends up as about 25,000 rows long, but only about 40 of those rows have data in. The rest of the rows are empty.

If a row has data in, there will be data in every column on that row, for example if row 2 was not empty, there would be data in A, B, C . . . and all the way to the last column without missing cells along the row.

I need to copy those 40 rows without blank rows in between. At the moment, I have a macro that deletes blank rows, but it takes hours to run. I really don't think what I'm doing is the quickest way and I was wondering if anyone knows a better alternative.

This is the code that's being used at the moment:

Sub DeleteBlankARows()
Dim r As Long


For r = Cells(Rows.Count, 1).End(xlUp).Row To 1 Step -1
If Cells(r, 1) = "" Then Rows(r).Delete
Next r


End Sub

 

[dermie_72]

use a filter for non blank cells, and then copy those to the destination. No need to loop.

 

[Rick Rothstein]

Assuming you run this macro with your data sheet (containing at least one row of data) active and that you want to copy that data to Sheet2...

Sub GetData()
  Columns("A").SpecialCells(xlConstants).EntireRow.Copy Sheets("Sheet2").Range("A1")
End Sub

 

[snb_]

If row 1 in sheet1 contains columnnames and the data in sheet1 have to be copied to sheet2:

Sub M_snb()
  with Sheets("sheet2")
    .Rows(1) = Sheets("sheet1").Rows(1).Value
    .Cells(2, 1) = "<>"""""
    Sheets("sheet1").UsedRange.AdvancedFilter 2, .Cells(1).CurrentRegion, .Cells(10, 1)
  end with
End Sub

 

[snb_]

or

sub M_snb()
  usedrange.columns(1).specialcells(4).entirerow.delete
end sub