Solved: macro to copy and paste only 5 rows of the filtered data from sheet2 to sheet1

[aravindhan_3]

Hi,

I used the following code to filter the data, I just wanted to copy the first 5 rows of the result and paste the same in sheet1 A2. How do I add the code to do my work...

Sub sort()

If Sheets("Sheet1").Range("B25").Value < 0 Then
Sheets("All 22 s").Select
Range("K2").Select
Range("A1:K65000").sort Key1:=Range("K2"), Order1:=xlAscending, Header:= _
xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
Rows("1:1").Select
Selection.AutoFilter
Selection.AutoFilter Field:=4, Criteria1:="A"
Selection.AutoFilter Field:=5, Criteria1:="22"
Selection.AutoFilter Field:=6, Criteria1:="1"
End If
End Sub

Thanks for the help..

[Bob Phillips]

Sub sort()
Dim rng As Range
Dim area As Variant
Dim rngRow As Range
Dim rngResult As Range
Dim numRows As Long

If Sheets("Sheet1").Range("B25").Value < 0 Then
Sheets("All 22 s").Select
Range("K2").Select
Range("A1:K65000").sort Key1:=Range("K2"), Order1:=xlAscending, Header:= _
xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
Rows("1:1").Select
Selection.AutoFilter
Selection.AutoFilter Field:=4, Criteria1:="A"
Selection.AutoFilter Field:=5, Criteria1:="22"
Selection.AutoFilter Field:=6, Criteria1:="1"

Set rng = Range("A1:K65000").SpecialCells(xlCellTypeVisible)
For Each area In rng.Areas

For Each rngRow In area.Rows

If rngResult Is Nothing Then

Set rngResult = rngRow.EntireRow
numRows = rngResult.Rows.Count
Else

Set rngResult = Union(rngResult, rngRow.EntireRow)
numRows = numRows + rngRow.EntireRow.Rows.Count
End If
If numRows = 5 Then Exit For
Next rngRow
If numRows = 5 Then Exit For
Next area
rngResult.copy Worksheets("Shgeet1").Range("A2")
End If
End Sub

[aravindhan_3]

Hi,

Thanks a lot, this what I wanted. its working fine for first time, but when I changed some values and run 2nd time, with differenct criterias.

This is the code with slight changes i maded in your code which works really good.


Sub DeptA()
Dim rng As Range
Dim area As Variant
Dim rngRow As Range
Dim rngResult As Range
Dim numRows As Long

If Sheets("SBO Investigations").Range("B25").Value < 0 Then
Sheets("All 22 s").Select
Range("K2").Select
Range("A1:K65000").sort Key1:=Range("K2"), Order1:=xlAscending, Header:= _
xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
Rows("1:1").Select
Selection.AutoFilter
Selection.AutoFilter Field:=4, Criteria1:="A"
Selection.AutoFilter Field:=5, Criteria1:="22"
Selection.AutoFilter Field:=6, Criteria1:="1"

Set rng = Range("A1:K65000").SpecialCells(xlCellTypeVisible)
For Each area In rng.Areas
For Each rngRow In area.Rows
If rngResult Is Nothing Then
Set rngResult = rngRow.EntireRow
numRows = rngResult.Rows.Count
Else
Set rngResult = Union(rngResult, rngRow.EntireRow)
numRows = numRows + rngRow.EntireRow.Rows.Count
End If
If numRows = 6 Then Exit For
Next rngRow
If numRows = 6 Then Exit For
Next area
rngResult.Copy Worksheets("SBO Investigations").Range("A28")
Sheets("All 22 s").Select
Rows("1:1").Select
Selection.AutoFilter
Sheets("SBO Investigations").Select
Else: Sheets("All 22 s").Select
Range("K2").Select
Range("A1:K65000").sort Key1:=Range("K2"), Order1:=xlDescending, Header:= _
xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
Rows("1:1").Select
Selection.AutoFilter
Selection.AutoFilter Field:=4, Criteria1:="A"
Selection.AutoFilter Field:=5, Criteria1:="22"
Selection.AutoFilter Field:=6, Criteria1:="1"

Set rng = Range("A1:K65000").SpecialCells(xlCellTypeVisible)
For Each area In rng.Areas
For Each rngRow In area.Rows
If rngResult Is Nothing Then
Set rngResult = rngRow.EntireRow
numRows = rngResult.Rows.Count
Else
Set rngResult = Union(rngResult, rngRow.EntireRow)
numRows = numRows + rngRow.EntireRow.Rows.Count
End If
If numRows = 6 Then Exit For
Next rngRow
If numRows = 6 Then Exit For
Next area
rngResult.Copy Worksheets("SBO Investigations").Range("A28")
Sheets("All 22 s").Select
Rows("1:1").Select
Selection.AutoFilter
Sheets("SBO Investigations").Select
End If
End Sub


I just added one if condition in the above code, but its working fine.

I wanted to made the changes in criteria and the cell where it has to be pasted.

I made the changes like this


If Sheets("SBO Investigations").Range("B25").Value < 0 Then from this to
If Sheets("SBO Investigations").Range("B35").Value < 0


and

from this Selection.AutoFilter Field:=4, Criteria1:="A" to Selection.AutoFilter Field:=4, Criteria1:="C"

and


from this rngResult.Copy Worksheets("SBO Investigations").Range("A28") to rngResult.Copy Worksheets("SBO Investigations").Range("A37")


the code upto filterting the data, copyting from sheet2 is perfect, but its just pasting the data in A28 and not in A37, could not make out where I am going wrong..

I have attached the same file for the reference..

Thanks once again for the help

[aravindhan_3]

Hi,

Sorry It worked... I did not change the cell value here...

Next area
rngResult.Copy Worksheets("SBO Investigations").Range("A28")


Now i changed and it worked like a charm..

Thanks a lot..