Copying sheets to a mastersheet Help needed

[auspcs]

Hi,
I have a spreadsheet with 33 sheets, the first(sheet1) is blank
except for headings, the second (Cat_id_maker) is a formula page for
generating Category ID numbers
The rest are formula pages that pull info from a Pricelist and arrange
it in the order that i need it. It then automatically numbers each Item
sequentially from 1 to around 900. I have written this sub to copy all
the lines I need from each sheet to the first sheet (sheet1) then sort
that sheet (sheet1) into a list from 1 to whatever. This page then gets
uploaded to my website.
This sub routine works well except that after it has run there are
around 30 lines that appear blank at the bottom of my sheet that have
something in them that the Lastrow function is seeing as data, this
stops me from deleting 30 odd lines that have a number in them but no
product information (these lines are unavoidable)
I need help with a routine that will find the last "REAL" row of info,
either in the sub or in the function PLEASE

The subroutine goes :

Sub CopyAllToOne()
' The following range is the Destination sheet selection
Application.Goto Reference:="MasterProducts"
Selection.ClearContents
Dim SourceRange As Range
Dim Destrange As Range
Dim DrTarget As Long
Dim EachSh As Worksheet
Dim DestSh As Worksheet
Application.ScreenUpdating = False
'Sheet1 is the target for the list
Set DestSh = Worksheets("Sheet1")
For Each EachSh In ThisWorkbook.Worksheets
'the following 2 IF statements exlude the target sheet & 1 other
that isn't wanted in the list
If EachSh.Name <> DestSh.Name Then
If EachSh.Name <> "Cat_id_maker" Then
DrTarget = LastRow(Sheets("sheet1")) + 1
With EachSh
Set SourceRange = .Range("A2:M" & .Range("A" &
Rows.Count).End(xlUp).Row)
End With
Set Destrange = Sheets("Sheet1").Range("A" & DrTarget)
SourceRange.Copy
Destrange.PasteSpecial xlPasteValues, , False, False
Application.CutCopyMode = False
End If
End If
Next
'The list is now done but it has a few lines that need to be
deleted
' We sort the list to put the unwanted lines at the bottom
Application.Goto Reference:="MasterProducts" 'The same range as
from before
Selection.Sort Key1:=Range("A2"), Order1:=xlAscending,
Header:=xlNo, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom,
_
DataOption1:=xlSortNormal
ActiveWindow.SmallScroll Down:=-1
Selection.Sort Key1:=Range("B2"), Order1:=xlAscending,
Key2:=Range("A2") _
, Order2:=xlAscending, Header:=xlNo, OrderCustom:=1,
MatchCase:=False, _
Orientation:=xlTopToBottom, DataOption1:=xlSortNormal,
DataOption2:= _
xlSortNormal
Application.ScreenUpdating = True
' Now I dont know how to get to the last row with data that isn't
blank
' I have about 20 lines that are blank but Lastrow finds them as
containing something
' If I clear the contents of these cells then save the worksheet
its fine
' But I need to be able to get to the last row of actual data
without doing this
' This sub needs the Lastrow function
End Sub
'Lastrow is used to determine which is the last used row of a sheet
Function LastRow(sh As Worksheet)
On Error Resume Next
LastRow = sh.Cells.Find(What:="*", _
After:=sh.Range("A1"), _
Lookat:=xlPart, _
LookIn:=xlFormulas, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious, _
MatchCase:=False).Row
On Error GoTo 0
End Function

If anyone wants to see the spreadsheets I can send them so you see the
problem.
I apologise for the length of this thread. I wanted to be as clear as I
could

 

[auspcs]

Ok, I have solved my problem myself, Now I have a new smaller problem.

I have a range that conatins all my data, the last 25 rows of data (
this figure can change) needs to be deleted. The rest of the sheet
above these rows contain data from col A to col M. I need a macro to
distinguish between the real data and the last 25 or so rows that only
contain data in col A The data in these cells by the way occurs twice
in col A the first occurrence is real data.
Any help would be appreciated.
More help than the original question would also be nice.

 

[auspcs]

I fixed it myself again. I feel i am talking to myself...lol
if anyones interested this is the final macro...

Sub CopyAllToOne()
' The following range is the Destination sheet selection
Application.Goto Reference:="MasterProducts"
Selection.ClearContents
Dim SourceRange As Range
Dim Destrange As Range
Dim DrTarget As Long
Dim EachSh As Worksheet
Dim DestSh As Worksheet
Application.ScreenUpdating = False
'Sheet1 is the target for the list
Set DestSh = Worksheets("Sheet1")
For Each EachSh In ThisWorkbook.Worksheets
'the following 2 IF statements exlude the target sheet & 1 othe
that isn't wanted in the list
If EachSh.Name <> DestSh.Name Then
If EachSh.Name <> "Cat_id_maker" Then
DrTarget = LastRow(Sheets("sheet1")) + 1
With EachSh
Set SourceRange = .Range("A2:M" & .Range("A"
Rows.Count).End(xlUp).Row)
End With
Set Destrange = Sheets("Sheet1").Range("A" & DrTarget)
SourceRange.Copy
Destrange.PasteSpecial xlPasteValues, , False, False
Application.CutCopyMode = False
End If
End If
Next
'The list is now done but it has a few lines that need to b
deleted
' We sort the list to put the unwanted lines at the bottom
Application.Goto Reference:="MasterProducts" 'The same range a
from before
Selection.Sort Key1:=Range("A2"), Order1:=xlAscending
Header:=xlNo, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
_
DataOption1:=xlSortNormal
ActiveWindow.SmallScroll Down:=-1
Selection.Sort Key1:=Range("B2"), Order1:=xlAscending
Key2:=Range("A2") _
, Order2:=xlAscending, Header:=xlNo, OrderCustom:=1
MatchCase:=False, _
Orientation:=xlTopToBottom, DataOption1:=xlSortNormal
DataOption2:= _
xlSortNormal
Set currentCell = Worksheets("Sheet1").Range("B2")
For Each cell In Range("B2:B1000")
Set nextCell = currentCell.Offset(1, 0)
If Len(currentCell.Value) = 0 Then
currentCell.EntireRow.Delete
End If
Set currentCell = nextCell
Next
Application.ScreenUpdating = True

' This sub needs the Lastrow function
End Sub
'Lastrow is used to determine which is the last used row of a sheet
Function LastRow(sh As Worksheet)
On Error Resume Next
LastRow = sh.Cells.Find(What:="*", _
After:=sh.Range("A1"), _
Lookat:=xlPart, _
LookIn:=xlFormulas, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious, _
MatchCase:=False).Row
On Error GoTo 0
End Functio