BİR TABLODAN DİĞERİNE BİLGİ AKTARIMI

[melwitch]

BÝR TABLODAN DÝÐERÝNE BÝLGÝ AKTARIMI

başka bir tabloya bilgi aktarmak istiyorum

 

[melwitch]

sanırım ilgili dosyaları yazıma eklememişim. Onları şimdi gönderiyorum

 

[veyselemre]

a sutununda bulunan satır numarası, 1 satırda bulunan sutun adına göre datadan bilgi alır

 

[melwitch]

Zaten şu anda bende formülle bu işi halletmekteyim ama IF kullanarak.

 

[melwitch]

Arkadaşlar henüz sorunuma yanıt bulamadım. Oluşturmak istediğim makro için yardımlarınıza ihtiyacım var.

 

[Tarkan VURAL]

DATA dosyanızı ziple tekrar yükleyebilir misiniz?
Yada tarkanvural@hotmail.com adresine gönderin bakalım.
Bir problemim var, tarayıcım .xls uzantılı dosyaları indirmiyor.

 

[ALPEN]

Bir problemim var, tarayıcım .xls uzantılı dosyaları indirmiyor.

http://www.excel.web.tr/viewtopic.php?t=2258

 

[danersin]

Bu kodları bir deneyin. Kod içinde açıklama var, kendi sütunlarınıza göre uyarlamalısınız.


'DÜZGÜN ÇALIÞMASI İÇİN A SÜTUNU HEP DOLU OLACAK DİYE DÜÞÜNÜLDÜ
[vb:1:cbeda3b1eb]
Sub Makro1()
i = 2
Do While Cells(i, 1) <> ""
If Cells(i, 23) = "İLK" Then
Sonsat = Sheets("Sayfa2").Cells(65536, 1).End(xlUp).Row
'SİZİN YAPMANIZ GEREKEN BLOK BAÞI eşitliğin sol tarafında 2,3,5,7 rakamları ile sağ taraftaki 3,5,7,9
'şeklindeki sütun rakamları eşleşecek
Sheets("Sayfa2").Cells(Sonsat, 2) = Cells(i, 3)
Sheets("Sayfa2").Cells(Sonsat, 3) = Cells(i, 5)
Sheets("Sayfa2").Cells(Sonsat, 5) = Cells(i, 7)
Sheets("Sayfa2").Cells(Sonsat, 7) = Cells(i, 9)
'SİZİN YAPMANIZ GEREKEN BLOK SONU
End If
i = i + 1
Loop
End Sub[/vb:1:cbeda3b1eb]

 

[keniken]

Aşağıdaki kodları module e yapıştırın ve düğme atayın..

Sub veri_aktar()
Dim i As Integer
Worksheets("Sheet1").Select
Range("W1").Select
For i = 1 To Cells(65536, 23).End(xlUp).Row
If Cells(i, 23).Value = "İLK" Then
Sheets("Sheet3").Cells(i, 2).Value = Sheets("Sheet1").Cells(i, 4).Value
Sheets("Sheet3").Cells(i, 3).Value = Sheets("Sheet1").Cells(i, 3).Value
Sheets("Sheet3").Cells(i, 4).Value = Sheets("Sheet1").Cells(i, 2).Value
Sheets("Sheet3").Cells(i, 5).Value = Sheets("Sheet1").Cells(i, 11).Value
Sheets("Sheet3").Cells(i, 6).Value = Sheets("Sheet1").Cells(i, 5).Value
Sheets("Sheet3").Cells(i, 7).Value = Sheets("Sheet1").Cells(i, 6).Value
Sheets("Sheet3").Cells(i, 12).Value = Sheets("Sheet1").Cells(i, 7).Value
Sheets("Sheet3").Cells(i, 13).Value = Sheets("Sheet1").Cells(i, 23).Value
Sheets("Sheet3").Cells(i, 27).Value = Sheets("Sheet1").Cells(i, 14).Value
Sheets("Sheet3").Cells(i, 28).Value = Sheets("Sheet1").Cells(i, 16).Value
End If
Next i
End Sub

 

[melwitch]

Arkadaşlar bir harikasınız. Birazdan deneyeceğim kod. ları. Þimdiden emekleriniz için ÇOK TEÞEKKÜR :dua:

 

[melwitch]

Arkadaşlar her ikinizinkinide denedim ancak bir sorun var kendi tabloma makroyu kopyaladığımda hiç bir işlem yapmıyor.

Keniken senin makronu göndermiş olduğum dosyada test ettim orada çalışıyor ancak birinci satırdan başlayarak taramaya başlıyor hangi satırda bulursa sheet3 de de aynı satıra gidiyor. Ancak benim asıl raporum 1200 küsürlerden başlıyor. Anlayacağın aktar dediğimde gidip 1200. satıra yazacaktır. Ki ana dosyada bu makroyu işletemedim o başka. Benim ana tablomda 4 adet sheet yer almakta. Ve senin yaptığın gibi sheet3 e sheet1 den veri aktarmam lazım. Acaba diğer sheetlerde olduğu için sorun çıkarıyor olabilirmi?

danersin seninkinide kopyalayıp dediğin gibi eşleştirme yaptım ama maalesef sonuç başarısız oldu.

Bana yardım ederseniz sevineceğim

 

[keniken]

Sub veri_aktar()
Dim i As Integer
Worksheets("Sheet1").Select
Range("N1").Select
For i = 1 To Cells(65536, 14).End(xlUp).Row
Sos = Sheets("Sheet3").Cells(65536, 2).End(xlUp).Row + 1

If Cells(i, 23).Value = "İLK" Then
Sheets("Sheet3").Cells(Sos, 2).Value = Sheets("Sheet1").Cells(i, 4).Value
Sheets("Sheet3").Cells(Sos, 3).Value = Sheets("Sheet1").Cells(i, 3).Value
Sheets("Sheet3").Cells(Sos, 4).Value = Sheets("Sheet1").Cells(i, 2).Value
Sheets("Sheet3").Cells(Sos, 5).Value = Sheets("Sheet1").Cells(i, 11).Value
Sheets("Sheet3").Cells(Sos, 6).Value = Sheets("Sheet1").Cells(i, 5).Value
Sheets("Sheet3").Cells(Sos, 7).Value = Sheets("Sheet1").Cells(i, 6).Value
Sheets("Sheet3").Cells(Sos, 12).Value = Sheets("Sheet1").Cells(i, 7).Value
Sheets("Sheet3").Cells(Sos, 13).Value = Sheets("Sheet1").Cells(i, 23).Value
Sheets("Sheet3").Cells(Sos, 27).Value = Sheets("Sheet1").Cells(i, 14).Value
Sheets("Sheet3").Cells(Sos, 28).Value = Sheets("Sheet1").Cells(i, 16).Value
End If
Next i
End Sub

 

[melwitch]

Anlayamıyorum neden benim klasöre aktardığımda çalışmıyor bu makro. Size gönderdiğim bir örneğiydi benim dosyamın. Þimdi bunları alıp kopyalayıp yapıştırıyorum makronun içine ama işlemiyor. Hata nerede yapıyor olabilirim

 

[keniken]

melwitch, sizin dediğiniz gibi sheet lerin sayısı böyle bir şeye yol açmaz..Dosyanızda module oluşturup kodları onun içine kopyalamanız gerekiyor..Bi de makro çalışmıyo derken neyi kastediyosunuz, hata mı veriyo ..isterseniz dosyanın tamamını gönderin, ben çalıştırayım.. :hey:

 

[melwitch]

çok teşekkürler ilgine ama sorunu buldum Size gönderdiğim dosyada "İLK" yazan satırın kolon sayısı değişmiş :kafa: Ben araya bir kolon açıldığının farkında olmadığımdan uğraşıp duruyordum. Neyseki hallettim sorunu. Kusura bakmayın sizleride uğraştırdım. TÞKKKK.. :icelim:

 

[Halit TÜRK]

veri aktar kopyala yapıştır yerine kes yapıştır

Selam Arkadaşlar... Yukarıda yazılan kodları kendime uyarladım ama aşağıdaki kodları kopyala yapıştır yerine kes yapıştır haline dönüştürmek için yardım edermisiniz...
Teşekkürler...

Sub veri_aktar()
Dim i As Integer
Worksheets("10 haneli seri no").Select
MsgBox "Geri Al Tamamlandı...", vbInformation, "Halit TÜRK"
For i = 1 To Cells(65536, 2).End(xlUp).Row
Sos = Sheets("İ ş P l a n ı").Cells(65536, 2).End(xlUp).Row + 1

If Cells(i, 17).Value = "GERİ" Then
Sheets("İ ş P l a n ı").Cells(Sos, 1).Value = Sheets("10 haneli seri no").Cells(i, 1).Value
Sheets("İ ş P l a n ı").Cells(Sos, 2).Value = Sheets("10 haneli seri no").Cells(i, 2).Value
Sheets("İ ş P l a n ı").Cells(Sos, 3).Value = Sheets("10 haneli seri no").Cells(i, 3).Value
Sheets("İ ş P l a n ı").Cells(Sos, 4).Value = Sheets("10 haneli seri no").Cells(i, 4).Value
Sheets("İ ş P l a n ı").Cells(Sos, 5).Value = Sheets("10 haneli seri no").Cells(i, 5).Value
Sheets("İ ş P l a n ı").Cells(Sos, 6).Value = Sheets("10 haneli seri no").Cells(i, 6).Value
Sheets("İ ş P l a n ı").Cells(Sos, 7).Value = Sheets("10 haneli seri no").Cells(i, 7).Value
Sheets("İ ş P l a n ı").Cells(Sos, 8).Value = Sheets("10 haneli seri no").Cells(i, 8).Value
Sheets("İ ş P l a n ı").Cells(Sos, 9).Value = Sheets("10 haneli seri no").Cells(i, 9).Value
Sheets("İ ş P l a n ı").Cells(Sos, 10).Value = Sheets("10 haneli seri no").Cells(i, 10).Value
Sheets("İ ş P l a n ı").Cells(Sos, 11).Value = Sheets("10 haneli seri no").Cells(i, 11).Value
Sheets("İ ş P l a n ı").Cells(Sos, 12).Value = Sheets("10 haneli seri no").Cells(i, 12).Value
Sheets("İ ş P l a n ı").Cells(Sos, 13).Value = Sheets("10 haneli seri no").Cells(i, 13).Value
Sheets("İ ş P l a n ı").Cells(Sos, 14).Value = Sheets("10 haneli seri no").Cells(i, 14).Value
Sheets("İ ş P l a n ı").Cells(Sos, 15).Value = Sheets("10 haneli seri no").Cells(i, 15).Value
Sheets("İ ş P l a n ı").Cells(Sos, 16).Value = Sheets("10 haneli seri no").Cells(i, 16).Value
Sheets("İ ş P l a n ı").Cells(Sos, 17).Value = Sheets("10 haneli seri no").Cells(i, 17).Value
End If
Next i
End Sub