Farklı sayfadan veri aktarma

[tukayf]

Değerli hocalarım. Nette arattım ancak sanırım doğru etiketle arayamadığım için çözümü bulamadım.
Elimde ayraç yazan yere kadar olan tablodaki veriler başka bir sayfada. Ayraçtan sonraki tablo başka bir sayfada. Soldaki şehir isimlerinin altındaki personeli başka sayfadaki tabloya sağdaki şekilde aktarmak istiyorum. sadece personel isimleri aktarılacak, yanındaki numaralar aktarılmayacak ve her aktarılan personel için aktif sütununa 1, açıklama sütununa ise bağlı bulunduğu il yazılacak. Kurum pc leri dosya ve ekran görüntüsü çıkışına izin vermediği için mecbur bu şekilde paylaşıyorum. Verdiğim zahmetten ötürü kusura bakmayınız. Yanıtlar için şimdiden teşekkürler.

Aydın	Aydın	İzmir	İzmir	Denizli	denizli	AYRAÇ	SİCİL	İSİM SOYİSİM	Aktif	Gecici	Açıklama
1. Personel	32132​	12. Personel	123132​	17. Personel	54651​	AYRAÇ	SİCİL	1. Personel	1​		Aydın
2. Personel	123​	13. Personel	131​	18. Personel	163541​	AYRAÇ	SİCİL	2. Personel	1​		Aydın
3. Personel	13​	14. Personel	1654​	19. Personel	13211​	AYRAÇ	SİCİL	3. Personel	1​		Aydın
4. Personel	1321​	15. Personel	6749​	20. Personel	1631​	AYRAÇ	SİCİL	4. Personel	1​		Aydın
5. Personel	13​	16. Personel	13146​	21. Personel	1321​	AYRAÇ	SİCİL	5. Personel	1​		Aydın
						AYRAÇ	SİCİL	12. Personel	1​		İzmir
						AYRAÇ	SİCİL	13. Personel	1​		İzmir
						AYRAÇ	SİCİL	14. Personel	1​		İzmir
						AYRAÇ	SİCİL	15. Personel	1​		İzmir
						AYRAÇ	SİCİL	16. Personel	1​		İzmir
						AYRAÇ	SİCİL	17. Personel	1​		Denizli
						AYRAÇ	SİCİL	18. Personel	1​		Denizli
						AYRAÇ	SİCİL	19. Personel	1​		Denizli
						AYRAÇ	SİCİL	20. Personel	1​		Denizli
						AYRAÇ	SİCİL	21. Personel	1​		Denizli

 

[uzmanamele]

Merhaba
Bu kodu deneyiniz.

Sub VeriAktar()
Set S1 = Sheets("Tablo1")
Set S2 = Sheets("Tablo2")
S2.Cells.ClearContents
S2.Range("A1") = "İsim Soyisim"
S2.Range("B1") = "Sicil"
S2.Range("C1") = "Açıklama"
x = 2
ssüt = S1.Cells(1, 1).End(2).Column
For i = 1 To ssüt Step 2
ssat = S1.Cells(1, i).End(xlDown).Row
For j = 2 To ssat
S2.Cells(x, "A") = S1.Cells(j, i)
S2.Cells(x, "B") = S1.Cells(j, i + 1)
S2.Cells(x, "C") = S1.Cells(1, i)
x = x + 1
Next
Next
End Sub

Verilerin olduğu sayfa adı: Tablo1
Aktarılan sayfa adı: Tablo2

 

[tukayf]

Hocam çok sağolun. Şu an mobildeyim. Pc başına geçince dönüş yapacağım. Zihninize sağlık.