Hi there, Ive got the following module running, it checks to see if a value is over 40, then drops all corresponding rows into another sheet. problem being is that is copies some of my header rows, which are just one row at the start of each sheet. anyone suggest how i can get around this dilemma? I am pretty new to this so please be clear with what why how ect. thanks again

Sub transferdata()
Dim ws As Worksheet
Dim rng As Range, cell As Range, rng1 As Range
Dim lr As Long, lr1 As Long, lrcnt As Long, cnt As Long, m As Long, n As Long
Application.ScreenUpdating = False
For Each ws In ActiveWorkbook.Sheets
If ws.Name <> "Major" Then
lr = ws.Cells(Rows.Count, "H").End(xlUp).Row
Set rng = ws.Range("H2:H" & lr)
n = Application.WorksheetFunction.CountIf(rng, ">40")
cnt = cnt + n
End If
Next ws
lr1 = Sheets("Major").Cells(Rows.Count, "H").End(xlUp).Row
Set rng1 = Sheets("Major").Range("H2:H" & lr1)
m = Application.WorksheetFunction.CountIf(rng1, ">40")
If m < cnt Then

For Each ws In ActiveWorkbook.Sheets
If ws.Name <> "Major" Then
lr = ws.Cells(Rows.Count, "H").End(xlUp).Row
Set rng = ws.Range("H2:H" & lr)
For Each cell In rng
lr1 = Sheets("major").Cells(Rows.Count, "H").End(xlUp).Row + 1
If cell.Value > 40 Then
cell.EntireRow.Copy Destination:=Sheets("Major").Range("A" & lr1)
End If
Next cell
End If
Next ws
End If
Sheets("Major").Activate
Application.ScreenUpdating = True
End Sub