İstenilen başlıkları tam eşleşme ile bir kaç sütunda aratıp çağırmak (yardım)

[ZonaX]

Herkese merhaba,
Üzerinde çalıştığım bir dosyamda bir türlü formüller ile isteğime cevap verebilecek şekilde nasıl veri çağıracağımı bulamadım, bir yerlerde tıkanıyorum ve bu konuda yardımlarınıza ihtiyacım var.

Ekte bulunan dosyamda "Mutabakat" sayfasında K,L,M,N sütunlarına 4. satırdan itibaren girdiğim müşteri kodlarının B sütununda karşılık gelen kodun bulunduğu satıra (H ve I) sütunlarına K,L,M,N sütunlarında bulunan yazdığım koda denk gelen başlıkları aktarsın. Yazdıklarım anlaşılabilir oldu mu bilemiyorum ve bu yüzden Dosyayı ekte sunuyorum, bu konuda yardımlarınızı bekliyorum.

 

[çıtır]

Çözümlenmiş dosyanız ektedir.Umarım istediğiniz gibi olmuştur.

 

[ZonaX]

Çözümlenmiş dosyanız ektedir.Umarım istediğiniz gibi olmuştur.

Teşekkürler ilginiz için ama yapmak istediğim maalesef bu değil, Siz sütun olarak tam tersini yapmışsınız.Ben (K,L,M,N ) sütunlarından (H ve I) sütunundaki satırlarda veri aktarmak istiyorum. Dosyamı biraz daha açıklayıcı olması açısından düzenleyip tekrar ek olarak koyuyorum.

 

[YUSUF44]

Düzeltme: Ben olayı zaten ters anlamışım. Bu çözümü dikkate almayınız.


Sorunuzu çözmek için aşağıdaki makroyu oluşturdum:

Sub mutabakat()
son = Cells(Rows.Count, "B").End(3).Row
Range("K4:N" & son) = ""
For i = 4 To son
    If Cells(i, "H") = "EVET" Then
        yenik = Cells(Rows.Count, "K").End(3).Row + 1
        Cells(yenik, "K").Select
        Cells(yenik, "K") = Cells(i, "B")
    ElseIf Cells(i, "H") = "HAYIR" And Cells(i, "I") = "KAPALI" Then
        yenil = Cells(Rows.Count, "L").End(3).Row + 1
        Cells(yenil, "L") = Cells(i, "B")
    ElseIf Cells(i, "H") = "HAYIR" And Cells(i, "I") = "KAPANDI" Then
        yenim = Cells(Rows.Count, "M").End(3).Row + 1
        Cells(yenim, "M") = Cells(i, "B")
    ElseIf Cells(i, "H") = "HAYIR" And Cells(i, "I") = "PASİF" Then
        yenin = Cells(Rows.Count, "N").End(3).Row + 1
        Cells(yenin, "N") = Cells(i, "B")
    End If
Next
End Sub

Normalde düzgün bir şekilde çalışıp işini yapması gerekiyor ama benim bilgisayarda nedense çalışmıyor.
Yeni satır değerini +2 yapınca çalışıyor ama +1 olunca çalışmıyor.
Hatta kontrol amaçlı koyduğum

        Cells(yenik, "K").Select

Satırında K4 hücresini seçmesi gerekirken K3 hücresini seçiyor. Nedenini çözemedim.
Siz bir dener misiniz?

 

[çıtır]

Dosyanız;Bu sefer doğru anlamışımdır,herhalde.

 

[ZonaX]

Dosyanız;Bu sefer doğru anlamışımdır,herhalde.

kesinlikle doğru anlamışsınız, tam da istediğim gibi, vaktinizi ayırıp yardımcı olduğunuz için sonsuz teşekkürler,harikasınız.

 

[çıtır]

kesinlikle doğru anlamışsınız, tam da istediğim gibi, vaktinizi ayırıp yardımcı olduğunuz için sonsuz teşekkürler,harikasınız.

İltifatlarınız ve dönüş yaptığınız için teşekkür ederim.Kolay gelsin.

 

[ZonaX]

Düzeltme: Ben olayı zaten ters anlamışım. Bu çözümü dikkate almayınız.


Sorunuzu çözmek için aşağıdaki makroyu oluşturdum:

Sub mutabakat()
son = Cells(Rows.Count, "B").End(3).Row
Range("K4:N" & son) = ""
For i = 4 To son
    If Cells(i, "H") = "EVET" Then
        yenik = Cells(Rows.Count, "K").End(3).Row + 1
        Cells(yenik, "K").Select
        Cells(yenik, "K") = Cells(i, "B")
    ElseIf Cells(i, "H") = "HAYIR" And Cells(i, "I") = "KAPALI" Then
        yenil = Cells(Rows.Count, "L").End(3).Row + 1
        Cells(yenil, "L") = Cells(i, "B")
    ElseIf Cells(i, "H") = "HAYIR" And Cells(i, "I") = "KAPANDI" Then
        yenim = Cells(Rows.Count, "M").End(3).Row + 1
        Cells(yenim, "M") = Cells(i, "B")
    ElseIf Cells(i, "H") = "HAYIR" And Cells(i, "I") = "PASİF" Then
        yenin = Cells(Rows.Count, "N").End(3).Row + 1
        Cells(yenin, "N") = Cells(i, "B")
    End If
Next
End Sub

Normalde düzgün bir şekilde çalışıp işini yapması gerekiyor ama benim bilgisayarda nedense çalışmıyor.
Yeni satır değerini +2 yapınca çalışıyor ama +1 olunca çalışmıyor.
Hatta kontrol amaçlı koyduğum

        Cells(yenik, "K").Select

Satırında K4 hücresini seçmesi gerekirken K3 hücresini seçiyor. Nedenini çözemedim.
Siz bir dener misiniz?

Yusuf Bey zaman ayırıp yardımcı olmaya çalıştığınız için çok teşekkürler, ben yinede yazdığınız makroyu inceleyip uyarlamaya çalışacağım, tekrar teşekkürler.