[حل شده] فیلتر کردن بعضی از ستون های یک جدول در یک شیت دیگر

[a.dal65]

با سلام خدمت اساتید

من یک جدول دارم با 8 تا ستون .

میخوام فقط از اون 8 تا ستون ، 3 تا ستون در یک شیت دیگه کپی بشه ( البته با یکسری فیلتر خاص بر روی همون 3 تا ستون)

مثال:
اطلاعات شیت اول با 8 تا ستون

ردیف	نام و نام خانوادگی	سن(سال)	وزن	جنسیت	سابقه بیماری	شماره تماس	مراجعه
1	علی	10	80	مرد	دارد	1111	داشته
2	محمد	11	90	مرد	دارد	1111	نداشته
3	کریم	12	100	مرد	دارد	1111	داشته
4	نقی	13	80	مرد	دارد	1111	داشته
5		14	90	مرد	دارد	1111	داشته
6	عطا	15	100	مرد	ندارد	11111111	نداشته
7	عطا 2	16	80	مرد	دارد	1111	داشته
8		17	90	مرد	ندارد	1111	نداشته
9		18	100	مرد	ندارد	1111	نداشته

اطلاعات فیلتر شده بر اساس ستون ها ی وزن ، سایقه بیماری و مراجعه :

وزن شان: 80 کیلو باشد
سابقه بیماری: داشته اند
مراجعه : داشته اند

(که از جدول اصلی فقط سطر 1 و 7 و 4 با این شرایط موجود هست)

وزن	سابقه بیماری	مراجعه
80	دارد	داشته
80	دارد	داشته
80	دارد	داشته

خود اکسل این قابلیتو داره(advance filter ) که در جای دیگه فیلتر کنه ، البته این امکان رو نداره که فقط 3 تا ستون رو در شیت دیگه بیاره.

[misammisam]

سلام
اگه میخواید فقط لیستشو داشته باشید میتونید خوب ستونهای اضافرو هاید یا حذف کنید ( حالا بصورت دستی یا با vb ).
اگرم میخواید ایمپورت کنید تو یه جدول یا جای دیگه هم گه با vb راحت میتونید با یه for راحت پیدا و ثبتش کنید .

[a.dal65]

نه میخوام ایمپورت بشه . چون یه سری کار دیگه هم روش میخوام انجام بدم.
ممنون میشم اگه کسی وقت کنه فقط برای یه ستون انجام بده .نمونه ای هم متاسفانه پیدا نکردم تو نت

[a.dal65]

50 درصد کار حل شد.
تونستم با این کد فیلتر و کپی کنم .
(الان همه جدول کپی میشه)
من میخوام فقط ستون 4 و6و8 کپی بشن .

Sub test()
Dim i, LastRow

LastRow = Sheets("DATA").Range("A" & Rows.Count).End(xlUp).Row

For i = 2 To LastRow
If Sheets("DATA").Cells(i, "D").Value = "80" And Sheets("DATA").Cells(i, "F").Value = "ÏÇÑÏ" And Sheets("DATA").Cells(i, "H").Value = "ÏÇÔÊå" Then

Sheets("DATA").Cells(i, "A").EntireRow.Copy Destination:=Sheets("Filtred").Range("A" & Rows.Count).End(xlUp).Offset(1)

End If
Next i
End Sub

[misammisam]

خوب کارو برای خودتون سخت کردید ، اینطوری بنویسید راحتره

Private Sub CommandButton1_Click()
lastrow = Sheet1.Range("a:h").Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
lastrow_2 = Sheet2.Range("a:d").Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row + 1

For i = 2 To lastrow
If ((Sheet1.Range("d" & i).Value = "80") And (Sheet1.Range("d" & i).Offset(0, 2).Value = "ÏÇÑÏ") And (Sheet1.Range("d" & i).Offset(0, 4).Value = "ÏÇÔÊå")) Then
lastrow_2 = lastrow_2 + 1
Sheet2.Range("b" & lastrow_2).Value = Sheet1.Range("d" & i).Value
Sheet2.Range("c" & lastrow_2).Value = Sheet1.Range("d" & i).Offset(0, 2).Value
Sheet2.Range("d" & lastrow_2).Value = Sheet1.Range("d" & i).Offset(0, 4).Value
End If
Next i
End Sub