Farklı sayfadaki listeden satırlar seçerek yeni bir liste oluşturma...

[Obaci]

Merhaba Arkadaşlar,
Var olan ürün listem, binden fazla satırlı uzun bir liste.
Alınan siparişlerin listesini oluştururken, bir ürünün sadece kodu girdiğimde,
tüm ürünlerin bulunduğu uzun listeden o koda sahip olan ürünün satırını bulup
yeni oluşturacağım sipariş listeme o satırı koysun istiyorum.

Bunu nasıl yapabileceğim konusunda önerilerinizi rica ediyorum.

 

[asi_kral]

Merhaba Arkadaşlar,
Var olan ürün listem, binden fazla satırlı uzun bir liste.
Alınan siparişlerin listesini oluştururken, bir ürünün sadece kodu girdiğimde,
tüm ürünlerin bulunduğu uzun listeden o koda sahip olan ürünün satırını bulup
yeni oluşturacağım sipariş listeme o satırı koysun istiyorum.

Bunu nasıl yapabileceğim konusunda önerilerinizi rica ediyorum.

Merhaba
Örnek dosya gönderebilir misiniz_?
İçinde açıklama eklerseniz şunu yapacağım şu olacak diye yardımcı olabilirim sanırım.

 

[Obaci]

Aşağıdaki linke yapmak istediğimi anlatmaya çalıştığım bir dosya koydum.
İlginize teşekkür ederim.

https://rapidshare.com/files/397333146/SiparisListesi.xlsx

 

[asi_kral]

Aşağıdaki linke yapmak istediğimi anlatmaya çalıştığım bir dosya koydum.
İlginize teşekkür ederim.

https://rapidshare.com/files/397333146/SiparisListesi.xlsx

Merhaba
Sipariş sayfasının kod bölümüne kopyalayın ve deneyin.

Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
'Konu       :   Kod'a Göre Veri Getir
'Mail       :   m.batu.1967@gmail.com
'Coder By    :   asi_kral_1967
Dim asi, kral, a
If Intersect(Target, Range("B:B")) Is Nothing Then Exit Sub
Set asi = Sheets("Sipariş"): Set kral = Sheets("Ürün Listaesi")
If Target <> Empty Then
a = Mid(Target, WorksheetFunction.Search(" ", Target) + 1, Len(Target) _
- WorksheetFunction.Search(" ", Target)) * 1
End If
If WorksheetFunction.CountIf(kral.Range("A:A"), a) > 0 Then
Cells(Target.Row, "A") = WorksheetFunction.Index(kral.Range("A:G"), _
WorksheetFunction.Match(a, kral.Range("A:A"), 0), 1)
Cells(Target.Row, "C") = WorksheetFunction.Index(kral.Range("A:G"), _
WorksheetFunction.Match(a, kral.Range("A:A"), 0), 3)
Cells(Target.Row, "D") = WorksheetFunction.Index(kral.Range("A:G"), _
WorksheetFunction.Match(a, kral.Range("A:A"), 0), 4)
Cells(Target.Row, "E") = WorksheetFunction.Index(kral.Range("A:G"), _
WorksheetFunction.Match(a, kral.Range("A:A"), 0), 5)
Cells(Target.Row, "F") = WorksheetFunction.Index(kral.Range("A:G"), _
WorksheetFunction.Match(a, kral.Range("A:A"), 0), 6)
Cells(Target.Row, "G") = WorksheetFunction.Index(kral.Range("A:G"), _
WorksheetFunction.Match(a, kral.Range("A:A"), 0), 7)
End If
End Sub

Eki inceleyiniz

 

[Obaci]

Merhaba Asi Kral Kardeş...
Kodları yapıştırıp denedim ama yapamadım... çalışmadı...
Ben çok uzun zamandır makro ile uğraşmadığımdan yanlış birşeyler yapıyor da olabilirim... ki kuvvetle muhtemeldir benim yanlış birşey yaptığım. İlgine teşekkür ederek biraz açıklama ile bana yardımcı olabilir misin desem...

 

[asi_kral]

Merhaba Asi Kral Kardeş...
Kodları yapıştırıp denedim ama yapamadım... çalışmadı...
Ben çok uzun zamandır makro ile uğraşmadığımdan yanlış birşeyler yapıyor da olabilirim... ki kuvvetle muhtemeldir benim yanlış birşey yaptığım. İlgine teşekkür ederek biraz açıklama ile bana yardımcı olabilir misin desem...

Dosyayı baksanız