How to copy non-blank rows from one sheet to another?

[Guest]

I am new to VBA and Excel programming. I wanted a way of copying all the rows
from one worksheet that had real data, into another worksheet so wrote the
script below. It does work, but I would like to know if its
good/bad/indifferent/inefficient and any ways it could be improved. Hopefully
from this I will then get a better idea of how to do VBA programming:

thanks

Sub copyRowsWithData(sourceSheet As Worksheet, destinationSheet As Worksheet)
'
' Routine to copy all, and only, non-blank rows from one worksheet to another.
'
Dim nextDestinationRow As Integer ' pointer to next row to use in
destination sheet
Dim anyDataInRow As Boolean ' keeps track of any non-blank cells
in row being searched
Dim rowsWithData As Range ' holds the range that extends to
the end of the data
Dim aRow As Range
Dim aCell As Range

Set rowsWithData = sourceSheet.UsedRange.Rows

nextDestinationRow = 1

For Each aRow In rowsWithData

anyDataInRow = False

For Each aCell In aRow.Cells
If Not (IsEmpty(aCell)) Then
anyDataInRow = True
End If
Next aCell

If anyDataInRow Then
sourceSheet.Select
aRow.Copy
destinationSheet.Select
Rows(nextDestinationRow).Select
ActiveSheet.Paste
nextDestinationRow = nextDestinationRow + 1
End If

Next aRow

End Sub
Sub Macro1()
'
Call copyRowsWithData(Worksheets("Sheet1"), Worksheets("Sheet2"))

End Sub

 

[Bernie Deitrick]

twofive,

You could use the specialcells method to cut that down to one line:

Sub CopyRowsWithData(sourceSheet As Worksheet, destinationSheet As
Worksheet)
sourceSheet.UsedRange.SpecialCells(xlCellTypeConstants, 23).EntireRow.Copy _
destinationSheet.Range("1:1")
End Sub

This will work if your data is composed solely of constants. If you have
formulas only, then change xlCellTypeConstants to xlCellTypeFormulas.

If you always have a mix, then you can use

Union(sourceSheet.UsedRange.SpecialCells(xlCellTypeConstants, 23), _
sourceSheet.UsedRange.SpecialCells(xlCellTypeFormulas,
23)).EntireRow.Copy _
destinationSheet.Range("1:1")

HTH,
Bernie
MS Excel MVP

 

[Bernie Deitrick]

Also, if your destination should be at the bottom of an existing sheet, you
could change the code

destinationSheet.Range("1:1")

to

destinationSheet.Range("A65536").End(xlUp)(2).EntireRow

Note that this example is based on column A always being filled.

HTH,
Bernie
MS Excel MVP