Data filter and copy paste the visible cells into different sheet

[harinsh]

Hi,

I have data in two different sheets and one common column values...that is part# ...I have list of part numbers in sheet1 and based on each part number I have to filter the value in second sheet and copy the values (entire rows) and paste into different sheet that is sheet3. Plz note that while filtering I may get 3 or 4 rows depends on the line items. Any number rows it should get copy and paste into different sheet.

Kindly help me to get the macro code for the above requirement.

Thank you

 

[JLGWhiz]

Hi,

I have data in two different sheets and one common column values...that is part# ...I have list of part numbers in sheet1 and based on each part number I have to filter the value in second sheet and copy the values (entire rows) and paste into different sheet that is sheet3. Plz note that while filtering I may get 3 or 4 rows depends on the line items. Any number rows it should get copy and paste into different sheet.

Kindly help me to get the macro code for the above requirement.

Thank you

You forgot to include the location of your data on the worksheets, but here is a generic macro and you can figure out where to make the changes to fit your needs. This macro assumes that part numbers are in column A on Sheets 1 and 2. It also assumes row 1 on each sheet as header row.

Sub filtCpy()
Dim sh1 As Worksheet, sh2 As Worksheet, sh3 As Worksheet, lr As Long, lr2 As Long, rng As Range, c As Range
Set sh1 = Sheets(1) 'Edit sheet name
Set sh2 = Sheets(2) 'Edit sheet name
Set sh3 = Sheets(3) 'Edit sheet name
lr = sh1.Cells(Rows.Count, 1).End(xlUp).Row 'Set the limit on criteria range on sheet 1, Column A
lr2 = sh2.Cells(Rows.Count, 1).End(xlUp).Row 'set the limit on search range on sheet 2, Column A
Set rng = sh1.Range("A2:A" & lr) 'Range with criteria
    For Each c In rng
        sh2.Range("A1:A" & lr).AutoFilter 1, c.Value, VisibleDropDown:=xlNo 'Filter search range
        On Error Resume Next 'Avoid interruption when no items filtered.
        'copy filtered items to sheet 3
        sh2.Range("A2:A" & lr).SpecialCells(xlCellTypeVisible).EntireRow.Copy sh3.Cells(Rows.Count, 1).End(xlUp)(2)
        On Error GoTo 0 'Restore error function
        sh2.Range("A1:A" & lr).AutoFilter 'turn off autofilter
    Next
End Sub

The comments in the code tell you what it is doing so you can make any necessary changes

 

[harinsh]

Thanks for your code...its working fine however in sheet 2 its copying only one line item.. refer the below example and out put which I got from the above macro

Sheet1

Part#

1

2

4

<colgroup><col style="width:48pt" width="64"> </colgroup><tbody>
</tbody>

Sheet 2

Part#	Name	Qty	Price
2	sdf	1	50.00
4	asf	2	20.00
35	sdf	3	30.00
65	sdgc	4	53.00
256	sd	5	45.00
32	er	6	68.00
45	cgdfg	9	98.00
2	eress	7	45.00
4	s	10	12.00

<colgroup><col><col><col><col></colgroup><tbody>
</tbody>

OUtput

2	sdf	1	50.00
4	asf	2	20.00

<colgroup><col span="4"></colgroup><tbody>
</tbody>

Desire output...

2	sdf	1	50.00
2	eress	7	45.00
4	asf	2	20.00
4	s	10	12.00

<colgroup><col span="4"></colgroup><tbody>
</tbody>

Thank you....

 

[Yahya]

hi
try this code
Excel 2007

	A
1	Part#
2	1
3	2
4	4

<colgroup><col style="width: 25pxpx"><col></colgroup><thead>
</thead><tbody>
</tbody>

Sheet1​

======


Excel 2007

	A	B	C	D
1	Part#	Name	Qty	Price
2	2	sdf	1	50
3	4	asf	2	20
4	35	sdf	3	30
5	65	sdgc	4	53
6	256	sd	5	45
7	32	er	6	68
8	45	cgdfg	9	98
9	2	eress	7	45
10	4	s	10	12

<colgroup><col style="width: 25pxpx"><col><col><col><col></colgroup><thead>
</thead><tbody>
</tbody>

Sheet2​

=============

and this is he result
Excel 2007

	A	B	C	D
1	Part#	Name	Qty	Price
2	2	sdf	1	50
3	4	asf	2	20
4	2	eress	7	45
5	4	s	10	12

<colgroup><col style="width: 25pxpx"><col><col><col><col></colgroup><thead>
</thead><tbody>
</tbody>

Sheet3​

Try this Code

Sub Test()Dim ws1 As Worksheet
Dim ws2 As Worksheet
Dim ws3 As Worksheet
Dim LR1 As Long
Dim LR2 As Long


Set ws1 = Sheets("Sheet1")
Set ws2 = Sheets("Sheet2")
Set ws3 = Sheets("Sheet3")


LR1 = ws1.Range("A" & Rows.Count).End(xlUp).Row
LR2 = ws2.Range("A" & Rows.Count).End(xlUp).Row


ws2.Range("A1:D" & LR2).AdvancedFilter xlFilterCopy, ws1.Range("A1:A" & LR1), ws3.Range("A1:D1")
End Sub

 

[harinsh]

Awesome!!! Its working perfect ....but I need to know if I want to include another filter criteria like in Sheet 2 if I filter names which is equal to "S" hence, I want only list which contains names "S" and also corresponding Part# number...is it possible to get the output???

Thank you very much....

 

[Yahya]

if you want to do that you should use wildcard with Criteria
and you should be careful with headers
in sheet 1

Excel 2007
	A	B
1	Part#	Name
2	1	*s*
3	2	*s*
4	4	*s*
Sheet1

and just edit code with this Part
ws2.Range("A1:D" & LR2).AdvancedFilter xlFilterCopy, ws1.Range("A1:A" & LR1), ws3.Range("A1:D1")
ws1.Range("A1:B" & LR!)