PC Review


Reply
Thread Tools Rate Thread

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

 
 
=?Utf-8?B?dHdvZml2ZXBpZQ==?=
Guest
Posts: n/a
 
      3rd Dec 2004
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
 
Reply With Quote
 
 
 
 
Bernie Deitrick
Guest
Posts: n/a
 
      3rd Dec 2004
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


"twofivepie" <(E-Mail Removed)> wrote in message
news:(E-Mail Removed)...
> 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



 
Reply With Quote
 
 
 
 
Bernie Deitrick
Guest
Posts: n/a
 
      3rd Dec 2004
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

"Bernie Deitrick" <deitbe @ consumer dot org> wrote in message
news:(E-Mail Removed)...
> 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
>
>
> "twofivepie" <(E-Mail Removed)> wrote in message
> news:(E-Mail Removed)...
> > 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

>
>



 
Reply With Quote
 
 
 
Reply

Thread Tools
Rate This Thread
Rate This Thread:

Posting Rules
You may not post new threads
You may not post replies
You may not post attachments
You may not edit your posts

BB code is On
Smilies are On
[IMG] code is On
HTML code is Off
Trackbacks are On
Pingbacks are On
Refbacks are Off


Similar Threads
Thread Thread Starter Forum Replies Last Post
Re: Excel macro to copy rows in one sheet and insert into another sheet Gord Dibben Microsoft Excel Misc 2 18th May 2012 02:53 PM
copy rows from one Data sheet to another sheet based on cell conte John McKeon Microsoft Excel Misc 2 15th May 2010 06:49 AM
Copy one cell from one sheet to another cell on another sheet chill in chile Microsoft Excel Misc 2 28th Feb 2008 03:06 AM
Search for rows in one sheet and copy into another sheet based on customer id chitiksha@gmail.com Microsoft Excel Worksheet Functions 1 22nd Oct 2007 03:09 AM
Inserting a row in sheet A should Insert a row in sheet B, removing a row in Sheet A should remove the corresponding row in sheet B Hannes Heckner Microsoft Excel Programming 1 5th Mar 2004 10:10 AM


Features
 

Advertising
 

Newsgroups
 


All times are GMT +1. The time now is 11:00 AM.