İkinci sayfadaki bilgileri birinci sayfaya macro ile yazdır

[search77]

Merhaba arkadaşlar,

Ekli dökümanda kodlar var bu kodların karşılarında ID ler var, ben bu kodların karşısına ID leri macro ile yazdırmak istiyorum, Açıklama örnek dosyada mevcut,

Yardımlarınız için şimdiden çok çok teşekkürler.

Saygılarımla.

 

[Orion1]

Ekli dosyayı inceleyiniz.

Sub aktar()
Sheets("LİSTE").Select
Application.ScreenUpdating = False
Range("B2:B65536").Clear
For i = 2 To Cells(65536, "A").End(xlUp).Row
    Set k = Range("A2:A65536").Find(Range("A" & i), , xlValues, xlWhole)
    If Not k Is Nothing Then
        Cells(i, "B").Value = Sheets("KİŞİLER").Cells(k.Row, "B").Value
    End If
Next
Application.ScreenUpdating = True
MsgBox "İşlem Tamamlandı...!!", vbOKOnly + vbInformation, "İŞLEM"
End Sub

 

[search77]

Ellerinize sağlık evren arkadaşım, süper olmuş.
Syg.

 

[Orion1]

Ellerinize sağlık evren arkadaşım, süper olmuş.
Syg.

Rica ederim.
İyi çalışmalar.

 

[search77]

Macro da sorun var galiba, ikinci sayfadaki bilgileri birinci sayfaya alırken hatalı bilgileri getiriyor.

Acil yardım lütfen.

Saygılarımla.

 

[Orion1]

Macro da sorun var galiba, ikinci sayfadaki bilgileri birinci sayfaya alırken hatalı bilgileri getiriyor.

Acil yardım lütfen.

Saygılarımla.

Pardon sayfa adını yazamayı unutmuşum.Ondan oluyordu.
dosyanız ekte.

Sub aktar()
Sheets("LİSTE").Select
Application.ScreenUpdating = False
Range("B2:B65536").Clear
For i = 2 To Cells(65536, "A").End(xlUp).Row
    Set k = Sheets("KİŞİLER").Range("A2:A65536").Find(Range("A" & i), , xlValues, xlWhole)
    If Not k Is Nothing Then
        Cells(i, "B").Value = Sheets("KİŞİLER").Cells(k.Row, "B").Value
    End If
Next
Application.ScreenUpdating = True
MsgBox "İşlem Tamamlandı...!!", vbOKOnly + vbInformation, "İŞLEM"
End Sub