PDA

View Full Version : copy help



oleg_v
02-16-2010, 06:14 AM
Hello

i have this macro:
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

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

thanks

Oleg

Bob Phillips
02-16-2010, 06:26 AM
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

oleg_v
02-16-2010, 06:46 AM
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
02-16-2010, 07:50 AM
Untesteds



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