جستجو بر اساس یک فیلد و کپی اطلات

[gagaloos]

سلام خسته نباشید
باور کنید وقتی این سایتو پیدا کردم از خوشحالی داشتنم بال درمیوردم
من یه فایل اکسل درست کردم که کارش صدور فاکتوره
3تا شیت داره که هر شیت مربوط به مشتری های یک ویزیتوره
شیت چهارم رو میخام جوری باشه که وقتی با وارد کردن شماره فاکتور، جستجو رو تویه این 3 شیت انجام بده و تمامی اطلاعات اون فاکتور رو کپی کن.
فایل رو ضمیمه کردم.
وقتی شماره فاکتور رو تویه قسمت قرمز رنگ وارد کردیم قسمت هایی که زرد شدن عینن منتقل بشن.
دستتون درد نکنه
ok30hen@yahoo.com
این ایمیلمه اگه درستش کردید واسم ایمیل کنید.

نمیدونم چه جوری فایلو ضمیمه کنم!

[shamsololama]

RE: جستجو بر اساس یک فیلد و کپی اطلات

با درود فراوان

حجم فایل زیاد بود براتوون میل کردم کدش هم اینجا قرار میدیم برای دیگر دوستانی که سئوال مشابه به این دارند

Private Sub Worksheet_Change(ByVal Target As Range)

Dim i, cod, j
Dim c, firstAddress
If Target.Address = "$I$3" Then

cod = Sheet3.Range("i3").Value
For i = 1 To Sheets.Count

With Sheets(i).Range("i1:i5000")

Set c = .Find(cod, LookIn:=xlValues, LookAt:=xlWhole)
If Not c Is Nothing Then
firstAddress = c.Address
Do
If c.Offset(0, -1) = Sheet3.Range("h3") Then

For j = 0 To 38
Sheet3.Range("i3").Offset(2 + j, -6).Value = c.Offset(2 + j, -6).Value
Sheet3.Range("i3").Offset(2 + j, -1).Value = c.Offset(2 + j, -1).Value
Next j
Exit Sub
End If
Set c = .FindNext(c)
Loop While Not c Is Nothing And c.Address <> firstAddress
End If
End With

Next i
End If
End Sub