Ara bul yapıştır Yada Vlookup sorunu

hüseyintok

Altın Üye
Katılım
11 Mart 2020
Mesajlar
58
Altın Üyelik Bitiş Tarihi
11-03-2025
Merhaba örnekde kaynakdan codlara göre aktarılacak datada bulup yapıştırmak istiyorum. Vlookup ile diğer datalar bozuluyor. VBA olarak hangi yöntemle yapabilirim.
Teşekkürler
 

Ekli dosyalar

hüseyintok

Altın Üye
Katılım
11 Mart 2020
Mesajlar
58
Altın Üyelik Bitiş Tarihi
11-03-2025
Bu konu için aşağıdaki macroyu uyarlamaya çalışıyorum ama olmadı yardımcı olabilirmisiniz.

Sub ara()
On Error Resume Next

Dim i As String
Dim sat As Range

For i = 1 To 5 Step 1

Set sat = Worksheets("Sheet1").Range("M6:M10").Find(What:=i)

Sheet1.Range("N" & sat, "Q" & sat).Copy
s = WorksheetFunction.CountA(Sheet1.[c1:c65536])
Sheet1.Range("e" & s + 1).PasteSpecial Paste:=xlPasteValues

Next i
End Sub
 

hüseyintok

Altın Üye
Katılım
11 Mart 2020
Mesajlar
58
Altın Üyelik Bitiş Tarihi
11-03-2025
bu konuda yardımcı olabilecek kimse yok mu?
 

Korhan Ayhan

Administrator
Yönetici
Admin
Katılım
15 Mart 2005
Mesajlar
41,488
Excel Vers. ve Dili
Microsoft 365 Tr-En 64 Bit
Deneyiniz.

C++:
Option Explicit

Sub Aktar()
    Dim Rng As Range, Find_Data As Range
    
    Application.ScreenUpdating = False

    For Each Rng In Range("C6:C" & Cells(Rows.Count, 3).End(3).Row)
        If IsNumeric(Rng) And Not IsEmpty(Rng) Then
            Set Find_Data = Range("M:M").Find(Rng, , , xlWhole)
            If Not Find_Data Is Nothing Then
                Find_Data.Offset(, 1).Resize(1, 4).Copy
                Rng.Offset(, 2).PasteSpecial xlPasteValues
            End If
        End If
    Next

    Range("A1").Select
    
    Application.CutCopyMode = False
    Application.ScreenUpdating = True
    
    MsgBox "Aktarım işlemi tamamlanmıştır.", vbInformation
End Sub
 
Üst