Eşleşen Verileri Diğer Sayfaya Aktar

[Emir Hüseyin Çoban]

. . .

Merhaba Arkadaşlar.

Mail listesi Sayfasında A sütununda olan veriler
FINT23 Sayfasında B sütununda da varsa buton ile
eşleşen kayıtların bilgilerini Son sayfasına aktarmalı.

Yardım ve fikirlerinizi bekliyorum.

. . .

 

[zafer]

Merhaba


Ekli dosyayı inceleyiniz.

 

[Emir Hüseyin Çoban]

. . .

Merhaba Zafer Bey,

Son sayfasında D sütununa, Mail listesi sayfasında C sütunundan.

Son sayfasında H ve I sütunlarına, Fint23 sayfasından J ve K sütunlarından veri getirmeli.

. . .

 

[zafer]

Merhaba

ekli dosyayı inceleyiniz.

sayfalardan son sayfasına gidecek sütünlarda değişiklik yaparsanız s3.Cells(4 + c, 3) sütün numarasını değiştiriniz.

s3.Cells(4 + c, 2) = s2.Cells(b, 2)
s3.Cells(4 + c, 3) = s2.Cells(b, 3)
s3.Cells(4 + c, 4) = s1.Cells(a, 3)
s3.Cells(4 + c, 5) = s2.Cells(b, 5)
s3.Cells(4 + c, 6) = s2.Cells(b, 6)
s3.Cells(4 + c, 7) = s2.Cells(b, 7)
s3.Cells(4 + c, 8) = s2.Cells(b, 10)
s3.Cells(4 + c, 9) = s2.Cells(b, 11)

 

[Emir Hüseyin Çoban]

. . .

Fint23 sayfasında verilerin sayısı çoğalınca aktarmada yanlışlık yapıyor.
Fınt23 ve Mail listesindeki veriler her zaman sıralı değil.

Örnekte Fint23 de sarı ile belirttiklerimi aktarmalı.

. . .

 

[Emir Hüseyin Çoban]

. . .

Düşeyara formülü ile yapılabilecek bir işlem ancak.
Veri sayısı belirsiz olduğu için ve dosya boyutunu yüksek olmaması için makro kodları yapmak istiyorum.
. . .

 

[Emir Hüseyin Çoban]

Çözüm

. . .

Aşağıdaki kodlar ile işlemi tamamladım.
Zafer Bey sizin verdiğiniz benzerler kodunu ve Usubaykan' nın düşeyara kodlarını kullandım.

Sub son_sayfasını_olustur()
iki = MsgBox(" Gönderi Listesini Oluşturmak İstiyor musunuz? ", vbYesNo, " Hüseyin Çoban ")
If iki = vbNo Then Exit Sub
Application.ScreenUpdating = False
Sheets("son").Range("A5:ı65536").ClearContents
Call cari_kodları_eşleştir
Call diger_bilgileri_yaz
Application.ScreenUpdating = True
End Sub

Sub cari_kodları_eşleştir()

On Error Resume Next
Set s1 = Sheets("MAİL LİSTESİ")
Set s2 = Sheets("FINT23")
Set s3 = Sheets("SON")

x = WorksheetFunction.CountA(s1.Range("A:a"))
Z = WorksheetFunction.CountA(s2.Range("b:b"))
For Each hucre In s1.Range("A2:a" & x)
Set bul = s2.Range("b2:b" & Z).Find(hucre)
If Not bul Is Nothing Then
c = c + 1
b = bul.Row
For i = 2 To 2
s3.Cells(4 + c, i) = s2.Cells(b, i)

Next


End If
Next
End Sub

Sub diger_bilgileri_yaz()
Dim U As Long
    For U = 5 To [B65536].End(3).Row
    
        If WorksheetFunction.CountIf(Sheets("fınt23").Range("B:B"), Cells(U, "B")) > 0 Then
            Cells(U, "C") = WorksheetFunction.VLookup(Cells(U, "B"), Sheets("FINT23").Range("B:K"), 2, 0)
            Else

        End If
        
        If WorksheetFunction.CountIf(Sheets("MAİL LİSTESİ").Range("A:A"), Cells(U, "B")) > 0 Then
            Cells(U, "D") = WorksheetFunction.VLookup(Cells(U, "B"), Sheets("MAİL LİSTESİ").Range("A:C"), 3, 0)
            Else

        End If
        
        If WorksheetFunction.CountIf(Sheets("fınt23").Range("B:B"), Cells(U, "B")) > 0 Then
            Cells(U, "E") = WorksheetFunction.VLookup(Cells(U, "B"), Sheets("FINT23").Range("B:K"), 4, 0)
            Else

        End If
        
        If WorksheetFunction.CountIf(Sheets("fınt23").Range("B:B"), Cells(U, "B")) > 0 Then
            Cells(U, "F") = WorksheetFunction.VLookup(Cells(U, "B"), Sheets("FINT23").Range("B:K"), 5, 0)
            Else

        End If
                
        If WorksheetFunction.CountIf(Sheets("fınt23").Range("B:B"), Cells(U, "B")) > 0 Then
            Cells(U, "G") = WorksheetFunction.VLookup(Cells(U, "B"), Sheets("FINT23").Range("B:K"), 6, 0)
            Else

        End If
                        
        If WorksheetFunction.CountIf(Sheets("fınt23").Range("B:B"), Cells(U, "B")) > 0 Then
            Cells(U, "H") = WorksheetFunction.VLookup(Cells(U, "B"), Sheets("FINT23").Range("B:K"), 9, 0)
            Else

        End If
        
        If WorksheetFunction.CountIf(Sheets("fınt23").Range("B:B"), Cells(U, "B")) > 0 Then
            Cells(U, "I") = WorksheetFunction.VLookup(Cells(U, "B"), Sheets("FINT23").Range("B:K"), 10, 0)
            Else

        End If
           
    Next
End Sub