copy help

[oleg_v]

Hello

i have this macro:
[VBA]Sub ProcessData()
Const TEST_COLUMN As String = "A" '<=== change to suit
Dim i As Integer
Dim LastRow As Long
Dim NextRow As Long
Dim mnth As Integer

With Sheets("sheet1")

mnth = InputBox("Supply the required month number")
If mnth > 0 And mnth <= 12 Then

LastRow = .Cells(.Rows.Count, TEST_COLUMN).End(xlUp).Row
NextRow = 5
For i = 6 To LastRow
H = 0

If Month(.Cells(i, "AU").Value) = mnth Then

NextRow = NextRow + 1

.Cells(i, "AV").Resize(, 1).Copy Worksheets("Sheet2").Cells(NextRow, "D")


End If
Next i
End If
End With

End Sub[/VBA]

how can i get it to copy only 30 rows from latest date and up from the same month

thanks

Oleg

[Bob Phillips]

[vba]

Sub ProcessData()
Const TEST_COLUMN As String = "A" '<=== change to suit
Dim i As Integer
Dim LastRow As Long
Dim NextRow As Long
Dim Threshold As Long
Dim mnth As Integer

With Sheets("sheet1")

mnth = InputBox("Supply the required month number")
If mnth > 0 And mnth <= 12 Then

LastRow = .Cells(.Rows.Count, TEST_COLUMN).End(xlUp).Row
NextRow = 5
For i = 6 To LastRow
H = 0

If Month(.Cells(i, "AU").Value) = mnth Then

NextRow = NextRow + 1
.Cells(i, "AV").Resize(, 1).Copy Worksheets("Sheet2").Cells(NextRow, "D")
Threshold = Threshold + 1
If Threshold > 30 Then Exit For
End If
Next i
End If
End With

End Sub
[/vba]

[oleg_v]

Thanks for the replay

the macro copies from the earliest date to the latest and
i need 30 latest parts from same month


thanks

[Bob Phillips]

Untesteds

[vba]

Sub ProcessData()
Const TEST_COLUMN As String = "A" '<=== change to suit
Dim i As Integer
Dim LastRow As Long
Dim Threshold As Long
Dim mnth As Integer

With Sheets("sheet1")

mnth = InputBox("Supply the required month number")
If mnth > 0 And mnth <= 12 Then

LastRow = .Cells(.Rows.Count, TEST_COLUMN).End(xlUp).Row
For i = LastRow To 6 Step -1
H = 0

If Month(.Cells(i, "AU").Value) = mnth Then

Worksheets("Sheet2").Rows(5).Insert
.Cells(i, "AV").Resize(, 1).Copy Worksheets("Sheet2").Range("D5")
Threshold = Threshold + 1
If Threshold > 30 Then Exit For
End If
Next i
End If
End With

End Sub
[/vba]