Bir sheet ten diger sheetlere dagıt

[Kemal Demir]

Arkadaslar Gunaydın

Bir Excel Sayfasında 4 Sheet'ten olusan datam var.

Sheet'ler(index,x,y,z)

İndex Sheet'inde 25367 Satırdan olusan S.no ve Unvan Kısmı mevcut
Diğer x,y,z Sheetlerınde Sadece Sıra no ları var.

Bir şeyler yazmaya calıstım ama zanedersem yanlıs yapıyorum

Hazırlana kod ise Aşagıdadır.

Sub dagıt()
'yanlıs olan birsey var yardımcı olabilirmisiniz.
'For x = 2 To 25327
'If Sheets("index").Select.Cells(x, 1) = Sheets("x").Select.Cells(x, 1) Then
'Sheets("x").Select.Cells(x, 2).Value = Sheets("index").Select.Cells(x, 2).Value
'End If
'If Sheets("index").Select.Cells(x, 1) = Sheets("y").Select.Cells(x, 1) Then
'Sheets("y").Select.Cells(x, 2).Value = Sheets("index").Select.Cells(x, 2).Value
'End If
'If Sheets("index").Select.Cells(x, 1) = Sheets("z").Select.Cells(x, 1) Then
'Sheets("z").Select.Cells(x, 2).Value = Sheets("index").Select.Cells(x, 2).Value
'End If

'Next


End Sub

Dosya Ektedir. Yardımcı olursanız Sevinirim.(Dosya Büyük biraz kucultmem gerekecek)Data boyutunu 5000 e dusurdum

 

[zafer]

Merhaba

Select 'leri kaldırın

If Sheets("index").Cells(x, 1) = Sheets("x").Cells(x, 1) Then
gibi

 

[Kemal Demir]

Sn.zafer, gunaydın,

Kod anladıgım kadarı ıle bole olsun dedın dıye dusundum denedım ama olmadı.

Sub dagıt()
For x = 2 To 2411
If Sheets("index").Cells(x, 1) = Sheets("x").Cells(x, 1) Then
Sheets("x").Cells(x, 2).Value = Sheets("index").Cells(x, 2).Value
End If
Next
End Sub

Calısmadı

Münkünse Dosyaya bakabilrmisiniz.
Saygılar.

 

[Kemal Demir]

Dosyada ki dagıtma işlemi neden gerceklesmıyor hata nerde?

Sub dagıt()
For x = 2 To 2411
If Sheets("index").Cells(x, 1) = Sheets("x").Cells(x, 1) Then
Sheets("x").Cells(x, 2).Value = Sheets("index").Cells(x, 2).Value
End If
Next
End Sub


Yanlıs olan ne yardımcı olurmusunuz.?

İyi Çalışmalar.

 

[osmantelci]

kodlarınızda hata yok ama mantık olarak şöyle olmalı

Sub dagıt()
For x = 2 To 2411
If Sheets("index").Cells(x, 1) = Sheets("x").Cells(x, 1) Then
Sheets("index").Cells(x, 2).Value = Sheets("x").Cells(x, 2).Value
End If
Next
End Sub

 

[kundakci]

Merhaba
bazı sorularım var
1-index sayfasındaki kodlar(ID) diğer x,y ve z sayfalarında varmı ?
2-X,Y,Z sayfasındaki ID lerini manuel mi ekliyorsun
3- sayfalarda olan Id'lerin bazıları INDEX sayfalasında yok

bunlara cevap verirseniz yardımcı olurum

iyi çalışmalar

 

[Kemal Demir]

Sn Kundakci İlginiz İçin Teşekkur Ederi. Dosya Büyüktü ve Ratgele bazı satırları sildim Ama Yine Aynı sayılar var muhakkak
Herhangibir manuel ekleme yok suan hazır datanın dagıtılması söz konusu

İlginiz İçin Teşkkur ederim.

 

[zafer]

Merhaba


Edit : kodları bir sonraki mesajımda tekrar düzenledim.

 

[Kemal Demir]

Sn . osmantelci

Kodu Dediğiniz Þekildede Duzenledim Ama Yine Olmadı.
Zannedersem de olmayacak :kafa: :kafa:

Dosyanın Revize Edilmiş hali Ektedir.

 

[zafer]

Merhaba

Kodları denermisiniz


Sub listele()


adet = Worksheets.Count

ason = WorksheetFunction.CountA(Sheets("index").Range("a1:a65536"))
bson = WorksheetFunction.CountA(Sheets("x").Range("a1:a65536"))
For wrk = 1 To adet
Sheets(wrk).Select
isim = ActiveSheet.Name
If isim <> "index" Then
bson = WorksheetFunction.CountA(Sheets(wrk).Range("a1:a65536"))
For a = 2 To ason
For b = 2 To bson
If Sheets(wrk).Cells(b, 1) = Sheets("index").Cells(a, 1) Then
Sheets(wrk).Cells(b, 2) = Sheets("index").Cells(a, 2)
End If


Next
Next

End If
Next
End Sub

 

[osmantelci]

İndeks sayfasına göre ünvanlar mı gelecek?

Eğer öyle ise:

Sub Unvan()
For j = 2 To 4
For Each i In Sheets(j).Range("A2:A" & Sheets(j).[A65536].End(xlUp).Row)
On Error Resume Next
i.Offset(0, 1) = WorksheetFunction.VLookup(i.Value, Sheets("index").[A2:B5001], 2, 0)
Next: Next
End Sub

 

[Kemal Demir]

Arkadaslar Çok teşekkur Ederim ayrı ayrı ilgilenen herkese.
Teşekkur Ederim.