Soru Sayfadan Sayfaya Veri Aktarımı ve Çoğaltma

[noartist]

Merhaba arkadaşlar,

Linkteki excel dosyasında Kart ve Liste olmak üzere iki sayfa bulunmaktadır.

Book2.xlsx

1 file sent via WeTransfer, the simplest way to send your files around the world

we.tl

Liste sayfasındaki bazı bilgilerin Kart sayfasındaki ilgili alanlara otomatik olarak aktarılması gerekmektedir.

Liste sayfasındaki Kart No bilgisiyle barkod oluşturup, bu barkodun Kart sayfasındaki Barkod alanında gözükmesi gerekiyor.

Bu kartların toplu olarak yazdırılması için, liste sayfasındaki kişi sayısı kadar yani her kişi için ayrı kart oluşması yani çoğaltılması gerekecek.

Konu hakkında yardımcı olabilir misiniz acaba ?

 

[Necdet]

Merhaba,
Aşağıdaki kodları bir modüle kopyalayıp deneyiniiz, umarım doğru anlamışımdır.

Sub deneme()

Dim barKod As String
Dim c As Range

If Not ActiveSheet.Name = "Kart" Then Sheets("Kart").Select

barKod = Split([B17], Chr(10))(1)

Set c = Sheets("Liste").Range("A:A").Find(barKod, LookIn:=xlValues)
If c Is Nothing Then End

Range("C7") = Sheets("Liste").Range("H" & c.Row)
Range("C8") = Sheets("Liste").Range("N" & c.Row)
Range("C9") = Sheets("Liste").Range("K" & c.Row)
Range("C10") = Sheets("Liste").Range("L" & c.Row)
Range("C11") = Sheets("Liste").Range("E" & c.Row)
Range("C12") = Sheets("Liste").Range("K" & c.Row)
Range("C13") = Sheets("Liste").Range("G" & c.Row)
Range("C14") = Sheets("Liste").Range("B" & c.Row)
Range("C15") = Sheets("Liste").Range("O" & c.Row)

End Sub

 

[noartist]

Merhaba,
Aşağıdaki kodları bir modüle kopyalayıp deneyiniiz, umarım doğru anlamışımdır.

Sub deneme()

Dim barKod As String
Dim c As Range

If Not ActiveSheet.Name = "Kart" Then Sheets("Kart").Select

barKod = Split([B17], Chr(10))(1)

Set c = Sheets("Liste").Range("A:A").Find(barKod, LookIn:=xlValues)
If c Is Nothing Then End

Range("C7") = Sheets("Liste").Range("H" & c.Row)
Range("C8") = Sheets("Liste").Range("N" & c.Row)
Range("C9") = Sheets("Liste").Range("K" & c.Row)
Range("C10") = Sheets("Liste").Range("L" & c.Row)
Range("C11") = Sheets("Liste").Range("E" & c.Row)
Range("C12") = Sheets("Liste").Range("K" & c.Row)
Range("C13") = Sheets("Liste").Range("G" & c.Row)
Range("C14") = Sheets("Liste").Range("B" & c.Row)
Range("C15") = Sheets("Liste").Range("O" & c.Row)

End Sub

Elinize sağlık hocam teşekkürler