Firma adı ve ürün koduna göre koşullu veri aktarma

[Galus]

Sevk sayfasındaki verilerden Firma adı ve Ürün koduna göre Sipariş sayfasıda Firma adının ve ürün kodunun ait olduğu satırın son hücresine giriş yaptırılıcak. Yalnız sipariş sayfasının H sütünunda formül olduğundan veri H den sonraki hücreye girilmeli.

Destekleriniz için şimdiden teşekkürler..

 

[Orion1]

Merhaba.
Sayın Galus Ekli dosyayı inceleyiniz.

Sub aktar()
Set s1 = Sheets("sevk")
Set s2 = Sheets("siparis")
Application.ScreenUpdating = False
For i = 2 To s1.Cells(65536, "A").End(xlUp).Row
    For k = 2 To s2.Cells(65536, "A").End(xlUp).Row
        If s1.Cells(i, "A").Value = s2.Cells(k, "A").Value And _
        s1.Cells(i, "B").Value = s2.Cells(k, "B").Value Then
            sut = s2.Cells(k, 256).End(xlToLeft).Column + 1
            s2.Cells(k, sut).Value = s1.Cells(i, "E").Value
        End If
    Next k
Next i
Application.ScreenUpdating = True
Set s1 = Nothing: Set s2 = Nothing
MsgBox "AKTARMA TAMAMLANDI..!!", vbOKOnly + vbInformation
End Sub

 

[Galus]

Hocam,

Allah razı olsun. Çok büyüksünüz. Sevk sayfasındaki bütün verileri aktarıyor. Sadece sarı renkli olan aktarılmamış. Sevk sayfası E8 aktarılmamış.

Hocam,
Tek koda göre aratsaydık,
Sadecene sarı boyalı Sevk E8 deki veri, Sipariş sayfasında önce firma adı sonra koda göre aratılarak sipariş sayfasına aktarmamız münkün mü?

Saygılarıml..

 

[Orion1]

Hocam,

Allah razı olsun. Çok büyüksünüz. Sevk sayfasındaki bütün verileri aktarıyor. Sadece sarı renkli olan aktarılmamış. Sevk sayfası E8 aktarılmamış.

Hocam,
Tek koda göre aratsaydık,
Sadecene sarı boyalı Sevk E8 deki veri, Sipariş sayfasında önce firma adı sonra koda göre aratılarak sipariş sayfasına aktarmamız münkün mü?

Saygılarıml..

Hesi aktarılmış.sevk sayfasındaki E8'deki veride aktarılmış.Ben denedim.Kodlar çalışıyor.Ama siz ,sadece ben E sütununda sarı renk ile boyadığım hücreler aktarılsın diyorsanız kodları o şekle göre tekrardan düzenlerim.

 

[Galus]

Evet hocam. tek bir kod aktarırsanız onu da üretim sayfasından direk işlerim.

Hürmetler...

 

[Orion1]

Evet hocam. tek bir kod aktarırsanız onu da üretim sayfasından direk işlerim.

Hürmetler...

Konuyu biraz açarmısınız?Tek bir veri aktarılacaksa hangi satırdaki veri aktarılacak?Bunun bilinmesi gerekiyor.

 

[Galus]

Hocam cevpta yanlış yazmışım özür dilerim. "Sevk sayfası E8 aktarılmamış." öyle bir şey yok. Sadecene tek bir değer aktarılsaydı son satır olduğu için ondan bahsettim. Mesala sadece Sevk sayfası E8 firma ve koda göre sipariş sayfasına aktarılsaydı demek istemiştim. Böyle bir ikinci makro olursa onuda günlük imalatlardan aktartırdım diye düşünmüştüm.

Çevreye verdiğim rahatsızlık nedeniyle tekrar tekrar özür dilerim.

Saygılarımla..

 

[Orion1]

Yani sevk sayfasındaki son verinin sipariş sayfasına aktarılmasını sağlayan bir tane dağa makro istiyorsunuz.Doğrumu anlamışım?

 

[Galus]

Evet hocam, sadece tek ürün.

Saygılarımla

 

[Orion1]

Ekli dosyayı inceleyiniz.

Sub son_satiri_aktar()
Set s1 = Sheets("sevk")
Set s2 = Sheets("siparis")
Application.ScreenUpdating = False
son_sat = s1.Cells(65536, "A").End(xlUp).Row
For k = 2 To s2.Cells(65536, "A").End(xlUp).Row
    If s1.Cells(son_sat, "A").Value = s2.Cells(k, "A").Value And _
    s1.Cells(son_sat, "B").Value = s2.Cells(k, "B").Value Then
        sut = s2.Cells(k, 256).End(xlToLeft).Column + 1
        s2.Cells(k, sut).Value = s1.Cells(son_sat, "E").Value
    End If
Next k
Application.ScreenUpdating = True
Set s1 = Nothing: Set s2 = Nothing
MsgBox "SON SATIR AKTARILDI..!!", vbOKOnly + vbInformation
End Sub

 

[Galus]

Hocam,

Hürmetler, çok emeğiniz geçti. Helal ediniz lütfen.

Saygılarımla..

 

[Orion1]

Hocam,

Hürmetler, çok emeğiniz geçti. Helal ediniz lütfen.

Saygılarımla..

Estafurullah.
Helal olsun.İyi çalışmalar.