Take a look at this:
http://www.rondebruin.nl/copy2.htm

Also, to delete blank rows, if there is a blanks in ColumnA, run this code:
Sub delete_rows()

Dim RowNdx As Long
Dim LastRow As Long
LastRow = ActiveSheet.UsedRange.Rows.Count
For RowNdx = LastRow To 1 Step -1
If Cells(RowNdx, "A").Value = "" Then
Rows(RowNdx).Delete
End If
Next RowNdx

End Sub

To delete blank rows, if the entire row is blank, run this code:
Public Sub DeleteBlankRows()

Dim R As Long
Dim C As Range
Dim Rng As Range

On Error GoTo EndMacro
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual

If Selection.Rows.Count 1 Then
Set Rng = Selection
Else
Set Rng = ActiveSheet.UsedRange.Rows
End If
For R = Rng.Rows.Count To 1 Step -1
If Application.WorksheetFunction.CountA(Rng.Rows(R).E ntireRow) = 0 Then
Rng.Rows(R).EntireRow.Delete
End If
Next R

EndMacro:

Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic

End Sub


IMPORTANT!! Make a backup of your file before doing any of this stuff.
There is nothing more annoying than deleting things, accidentally, because
you ran code and it did not do what you thought it would do.

Regards,
Ryan---


--
RyGuy


"TGalin" wrote:

I have a workbook with 50 worksheets. If I wanted to gather all the data
from each worksheet and then paste it onto one worksheet named Report, I
could use the following code and repeat until I have covered all 50
worksheets. However I am wondering can this code be shortened as well as
modified so that it only copies cells from the range A1:B24 that have
contents inside them? Also on the reports page where all the results are
pasted into Column A, is it possible to delete the rows that do not have any
contents in them?

Sub CopyPasteCode()
Sheets.Add
Sheets("Sheet1").Select
Sheets("Sheet1").Name = "Report"
Sheets("Quest 1").Select
Range("A1:B24").Select
Selection.Copy
Sheets("Report").Select
ActiveSheet.Paste
Sheets("Quest 2").Select
Range("A1:B24").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Report").Select
Range("A25").Select
ActiveSheet.Paste
Sheets("Quest 3").Select
Range("A1:B24").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Report").Select
Range("A49").Select
ActiveSheet.Paste
End Sub