ali.b
2014/08/02, 08:06
با سلام
با این کد میتونین سولو مورد نظر رو معرفی کنین و بعدش تمامی داده هایی که مربوط به اون سلول در اون ردیف هست رو به یک شیت جدید انتقال بدین
Option Explicit
Sub test()
Application.ScreenUpdating = 0
With Range("k1:k" & Cells(Rows.Count, "k").End(xlUp).Row)
.AutoFilter 1, "absorkhi"
.Offset(1).EntireRow.Copy Sheets.Add.Range("a1")
.AutoFilter
End With
Application.ScreenUpdating = 1
End Sub
قسمت هایی که نیاز به تغییر هست رو با رنگ ابی مشخص هستند که بر حسب نیازتون تغییر بدین
با این کد میتونین سولو مورد نظر رو معرفی کنین و بعدش تمامی داده هایی که مربوط به اون سلول در اون ردیف هست رو به یک شیت جدید انتقال بدین
Option Explicit
Sub test()
Application.ScreenUpdating = 0
With Range("k1:k" & Cells(Rows.Count, "k").End(xlUp).Row)
.AutoFilter 1, "absorkhi"
.Offset(1).EntireRow.Copy Sheets.Add.Range("a1")
.AutoFilter
End With
Application.ScreenUpdating = 1
End Sub
قسمت هایی که نیاز به تغییر هست رو با رنگ ابی مشخص هستند که بر حسب نیازتون تغییر بدین