Sayfalar arası arattırma yapmak

[bono]

Arkadaşlar

Sheet1 de ana tablom , sheet2 de ise ana tablom üzerinde değişiklik yapmak istediğim firmaların ek bilgileri bulunmakta. Sheet1 çok büyük bir data ve sheet2 de o datanın içerisindeki bazı firmaları buldurup yanlarına tarih ve neden bilgisini yazdırmak istiyorum. Ancak bazı firmaların kodları aynı olabilmektedir.

Bunu yazarak anlatmak zor olduğundan bir örnek tablo hazırladım ve gönderiyorum

Biliyorum hepiniz yoğunsunuz ama eğer bana çok acele yardım edebilecek bir arkadaşım olursa sevinirim. Hazırlamam gereken bir tablo var ve bu firmaları tek tek arattırmam gerçekten olanaksız görünüyor.

şimdiden teşekkürler

 

[bono]

Aşağıdaki gibi bir kod yazdım ama bununla sadece a6 da gördüğü koddaki müşterilere bilgi yazdırabiliyorum. ama alttaki farklı kodlar içinde (sayfadaki kod kolonundan bahsediyorum) aynı şeyi yapması gerekiyor. bu döngüyü sağlayamadım. Yardım lütfen

Sub ARATMA()

sat = Sheets("sheet1").Cells(65536, 1).End(xlUp).Row

For A = 1 To sat

If Sheets("sheet1").Cells(A, 1) = Sheets("Sheet2").[A6].Value Then
Sheets("sheet1").Cells(A, 3) = Sheets("Sheet2").[c6].Value
Sheets("sheet1").Cells(A, 4) = Sheets("Sheet2").[f6].Value
End If
Next
End Sub

 

[bono]

leventm

bana daha öncede diğer konularda yardımcı olduğunuz için sizden bu konuda da yardım alabilmem mümkünmü? Benim için gerçekten önemli bu sorunu çözebilmem. En azından yazdığım makro üzerine bir kod koyulsa sorun çözülmezmi sizce. Dün geceden beri denemediğim şey kalmadı ama başaramadım

 

[bono]

Bir arkadaşım yardımıyla makroyu çözüme kavuştuarabildim. Üzerinde uğraşıp emek harcayan arkadaşlara teşekkür ediyorum.

Bir önceki kodum üzerinde yapılan ufak bir oynama ile sorun halloldu. Belki başka bir şey için sizlere de lazım olur diye aşağıda gönderiyorum

Sub ARATMA()

sat = Sheets("sheet1").Cells(65536, 1).End(xlUp).Row
sat2 = Sheets("sheet2").Cells(65536, 1).End(xlUp).Row

For A = 2 To sat
For B = 1 To sat2
' If Sheets("sheet1").Cells(A, 1) = Sheets("Sheet2").Cells(B + 5, 1).Value Then ' sadece kod karşılaştırması yapılır
If (Sheets("sheet1").Cells(A, 1) = Sheets("Sheet2").Cells(B + 5, 1).Value) And (Sheets("sheet1").Cells(A, 2) = Sheets("Sheet2").Cells(B + 5, 2).Value) Then ' kod ve firma karşılaştırması yapılır
Sheets("sheet1").Cells(A, 3) = Sheets("Sheet2").Cells(B + 5, 3).Value ' c kolonu
Sheets("sheet1").Cells(A, 4) = Sheets("Sheet2").Cells(B + 5, 6).Value ' f kolonu
End If
Next B
Next A
End Sub


İyi akşamlar