Sheets lerden tek bir sheet'e veri göndermek

[asmirk]

Arkadaşlar benim yapmak istediğim excel de bulunan sayfalarda (sheets) bulunan verileri başka bir sayfada toplamak istiyorum. Yaşamış olduğum sorunu örnekte daha açıklayıcı anlatmaya çalıştım.

Yardım edeçeklere şimdiden teşekkürlerimi sunarım

Saygılarımla..

 

[asmirk]

Sevgili Ustalarım Sadece sorduğum sorunun bir çözümü var mı acaba onu öğrenmek istiyorum. Eğer yoksa hazırladığım projenin yönünü değiştirmek zorunda kalacam. Saygılarımla..

 

[Levent Menteşoğlu]

Sorunuzun çözümü elbette vardır. Ancak onay kutusu kullanmak yazılacak kodlamayı ve tasarımı zorlaştırmaktadır. Bu sebeple onay kutusu yerine örneğin O sütunundaki hücrelere çift tıklayınca işaret atan bir kodlama yaptıktan sonra işlem yapmak daha kolay olacaktır. Aşağıdaki linkte benzer bir uygulama mevcuttur, bunu incelemenizi öneririm.

Listeden istediğimi tıklayıp farklı sayfadan çıktı alma ?

 

[tahsinanarat]

Ben bir çalışma yaptım

İstediğiniz şekilde bir çalışma yaptım umarım işinize yarar. Dosyanız ektedir.
Kolay gelsin.

 

[asmirk]

Sevgili Levent Menteşoğlu ve tahsinanarat gösterdiğiniz ilgiye çok teşekkür ederim.

Yalnız tahsin bey sistemde tam işlemeyen bir durum var çunkü orneğin 1. sayfada 1 satıra,2.sayfada1. satıra,3.sayfada 1. satıra basıyorum ve tek tek yolluyorum oluryor Fakat sonra bu satırlardakı cekler basılı ıken bide ıkıncı satırlara tek tek basmaya baslayınca eskileri siliyor ve yeniden başlıyor yani bir öncekiler siliniyor. Buna nasıl bir çözüm bülabilriz acaa yardımcı olursanız sevinirim. Çünkü verilerin sağlıklı depolanması benim için çok önemli.

Saygılarımla

Sub taktar()
Application.Run "Seçiliolanı_aktar.xls!Module1.raporla"
Sheets("Sayfa2").Select
Application.Run "Seçiliolanı_aktar.xls!raporla2"
Sheets("Sayfa3").Select
Application.Run "Seçiliolanı_aktar.xls!raporla3"
ActiveWindow.ScrollColumn = 2
ActiveWindow.ScrollColumn = 3
Range("P6").Select

End Sub

Birde hepsni aktar dediğimde böyle bir sounla karşılaşıyorum.

 

[asmirk]

Çözümü buldum sanıyorum Türkçe karakterler

 

[asmirk]

BU makroda anlayamadığım bazı yeler var Onların dosyada nereleri temsil ettiğini ve ne anlama geldiğini kısaca yazabilirseniz çok sevinirim.Takıldığım yerler kırmızı renktedir.

Saygılarımla.


Sub raporla()
Sheets("a").Select
Range("e7:m35").ClearContents

Sheets("Sayfa1").Select
For i = 3 To Cells(35, "d").End(xlUp).Row
If Cells(i, "o").Value = "o" Or Cells(i, "o").Value = Chr(252) Then
rn1 = "(d" + LTrim(Str(i)) + ":l" + LTrim(Str(i)) + ")"
Sayfa1_veri1 = Cells(i, "d").Value
Sayfa1_veri2 = Cells(i, "e").Value
Sayfa1_veri3 = Cells(i, "f").Value
Sayfa1_veri4 = Cells(i, "g").Value
Sayfa1_veri5 = Cells(i, "h").Value
Sayfa1_veri6 = Cells(i, "ı").Value
Sayfa1_veri7 = Cells(i, "j").Value
Sayfa1_veri8 = Cells(i, "k").Value
Sayfa1_veri9 = Cells(i, "l").Value

Sheets("a").Select
s2_son = Cells(65536, "e").End(xlUp).Row + 1

Cells(s2_son, "e") = Sheets("sayfa1").Cells(i, "d").Value
Cells(s2_son, "f") = Sheets("sayfa1").Cells(i, "e").Value
Cells(s2_son, "g") = Sheets("sayfa1").Cells(i, "f").Value
Cells(s2_son, "h") = Sheets("sayfa1").Cells(i, "g").Value
Cells(s2_son, "ı") = Sheets("sayfa1").Cells(i, "h").Value
Cells(s2_son, "j") = Sheets("sayfa1").Cells(i, "ı").Value
Cells(s2_son, "k") = Sheets("sayfa1").Cells(i, "j").Value
Cells(s2_son, "l") = Sheets("sayfa1").Cells(i, "k").Value
Cells(s2_son, "m") = Sheets("sayfa1").Cells(i, "l").Value
Sheets("Sayfa1").Select
End If
Next
Sheets("a").Select
Cells(1, 1).Select
End Sub
Sub raporla2()
Sheets("a").Select
'Range("e7:m35").ClearContents

Sheets("Sayfa2").Select
For i = 3 To Cells(35, "d").End(xlUp).Row
If Cells(i, "o").Value = "o" Or Cells(i, "o").Value = Chr(252) Then
rn1 = "(d" + LTrim(Str(i)) + ":l" + LTrim(Str(i)) + ")"
Sayfa1_veri1 = Cells(i, "d").Value
Sayfa1_veri2 = Cells(i, "e").Value
Sayfa1_veri3 = Cells(i, "f").Value
Sayfa1_veri4 = Cells(i, "g").Value
Sayfa1_veri5 = Cells(i, "h").Value
Sayfa1_veri6 = Cells(i, "ı").Value
Sayfa1_veri7 = Cells(i, "j").Value
Sayfa1_veri8 = Cells(i, "k").Value
Sayfa1_veri9 = Cells(i, "l").Value

Sheets("a").Select
s2_son = Cells(65536, "e").End(xlUp).Row + 1

Cells(s2_son, "e") = Sheets("sayfa2").Cells(i, "d").Value
Cells(s2_son, "f") = Sheets("sayfa2").Cells(i, "e").Value
Cells(s2_son, "g") = Sheets("sayfa2").Cells(i, "f").Value
Cells(s2_son, "h") = Sheets("sayfa2").Cells(i, "g").Value
Cells(s2_son, "ı") = Sheets("sayfa2").Cells(i, "h").Value
Cells(s2_son, "j") = Sheets("sayfa2").Cells(i, "ı").Value
Cells(s2_son, "k") = Sheets("sayfa2").Cells(i, "j").Value
Cells(s2_son, "l") = Sheets("sayfa1").Cells(i, "k").Value
Cells(s2_son, "m") = Sheets("sayfa1").Cells(i, "l").Value
Sheets("Sayfa2").Select
End If
Next
Sheets("a").Select
Cells(1, 1).Select
End Sub

Sub raporla3()
Sheets("a").Select
'Range("e7:m35").ClearContents

Sheets("Sayfa3").Select
For i = 3 To Cells(35, "d").End(xlUp).Row
If Cells(i, "o").Value = "o" Or Cells(i, "o").Value = Chr(252) Then
rn1 = "(d" + LTrim(Str(i)) + ":l" + LTrim(Str(i)) + ")"
Sayfa1_veri1 = Cells(i, "d").Value
Sayfa1_veri2 = Cells(i, "e").Value
Sayfa1_veri3 = Cells(i, "f").Value
Sayfa1_veri4 = Cells(i, "g").Value
Sayfa1_veri5 = Cells(i, "h").Value
Sayfa1_veri6 = Cells(i, "ı").Value
Sayfa1_veri7 = Cells(i, "j").Value
Sayfa1_veri8 = Cells(i, "k").Value
Sayfa1_veri9 = Cells(i, "l").Value

Sheets("a").Select
s2_son = Cells(65536, "e").End(xlUp).Row + 1

Cells(s2_son, "e") = Sheets("sayfa3").Cells(i, "d").Value
Cells(s2_son, "f") = Sheets("sayfa3").Cells(i, "e").Value
Cells(s2_son, "g") = Sheets("sayfa3").Cells(i, "f").Value
Cells(s2_son, "h") = Sheets("sayfa3").Cells(i, "g").Value
Cells(s2_son, "ı") = Sheets("sayfa3").Cells(i, "h").Value
Cells(s2_son, "j") = Sheets("sayfa3").Cells(i, "ı").Value
Cells(s2_son, "k") = Sheets("sayfa3").Cells(i, "j").Value
Cells(s2_son, "l") = Sheets("sayfa3").Cells(i, "k").Value
Cells(s2_son, "m") = Sheets("sayfa3").Cells(i, "l").Value
Sheets("Sayfa3").Select
End If
Next
Sheets("a").Select
Cells(1, 1).Select
End Sub

 

[Orion1]

For i = 3 To Cells(35, [B][COLOR="Red"]"d"[/COLOR][/B]).End(xlUp).Row
If Cells(i, "o").Value = [B][COLOR="red"]"o"[/COLOR][/B] Or Cells(i, "o").Value = Chr(252) Then

ilk satırdaki "d" D sütunu demektir.
İkinci satırdaki = "o" , "o" sabiti.(string değeri)

 

[asmirk]

Çok teşekkür ederim sayın Evren Gizlen peki "e" ne anlama geliyor burada?

 

[Orion1]

Çok teşekkür ederim sayın Evren Gizlen peki "e" ne anlama geliyor burada?

s2_son = Cells(65536, "e").End(xlUp).Row + 1
"e" = E sütunu

 

[asmirk]

Çok teşekkür ederim Evren Gizlen bey

 

[Orion1]

Çok teşekkür ederim Evren Gizlen bey

Rica ederim.

 

[asmirk]

Arkadaşlar tahsinanarat arkadaşımızın göstermiş olduğu örnekteki makroyu bir türlü kanalize edemedim çalışmama bana yardımcı olabilir misiniz? lütfen. Örneği eke ekledim yardım edeceklere şimdiden teşekkürler...


Saygılarımla..

 

[tahsinanarat]

Sn. Asmirk, aktarma işlemi olayında aktardıklarınız devamlı "a" sayfasında kalıcı mı olacak, eğer öyle ise
Sub raporla()
Sheets("a").Select
'Range("e7:m35").ClearContents
Sheets("Sayfa1").Select
For i = 3 To Cells(35, "d").End(xlUp).Row
If Cells(i, "o").Value = "o" Or Cells(i, "o").Value = Chr(252) Then

kırmızı renkli satırı iptal ediniz, tablonuzun boşaltılmasını istediğinizde tabloyu silmek için ayrıca bir makro yazınız.

 

[asmirk]

Çok teşekkür ederim sayın Tahsinanarat lakin aynı uygulamayı kendi örnekte belirtiğim tabloya kanalize ettiğimde rapor bölümüne (sizin verdiğiniz örekte "a")
Sayfasına sadece 1 satırı ekliyor yani kactane secersem seceyim 1 tane ekliyor.Bence hepsini ekliyor ama bir alt satıra atamıyor.Çünkü seçip hepsini aktar dediğimde eklerken görüyorum hızlı bir şekilde geçişini.Neden yapamadım ama stringi de sanıyorum ayarladım ama yinede başaramadım.

 

[asmirk]

Sorunum ekteki örnekte daha açık gözükmekte.Acaba nerede hata yapıyorum yardım ederseniz memnun olurum.

Saygılarımla
Şöylede denedim olmadı

Sub raporla()
Sheets("hasila").Select
Range("e7:m35").ClearContents

Sheets("sevki").Select
For i = 6 To Cells(35, "a").End(xlUp).Row
If Cells(i, "n").Value = "n" Or Cells(i, "n").Value = Chr(252) Then
rn1 = "(b" + LTrim(Str(i)) + ":l" + LTrim(Str(i)) + ")"
Sayfa1_veri1 = Cells(i, "d").Value
Sayfa1_veri2 = Cells(i, "e").Value
Sayfa1_veri3 = Cells(i, "f").Value
Sayfa1_veri4 = Cells(i, "g").Value
Sayfa1_veri5 = Cells(i, "h").Value
Sayfa1_veri6 = Cells(i, "ı").Value
Sayfa1_veri7 = Cells(i, "j").Value
Sayfa1_veri8 = Cells(i, "k").Value
Sayfa1_veri9 = Cells(i, "l").Value

Sheets("hasila").Select
s2_son = Cells(65536, "b").End(xlUp).Row + 1

Cells(s2_son, "e") = Sheets("sevki").Cells(i, "d").Value
Cells(s2_son, "f") = Sheets("sevki").Cells(i, "e").Value
Cells(s2_son, "g") = Sheets("sevki").Cells(i, "f").Value
Cells(s2_son, "h") = Sheets("sevki").Cells(i, "g").Value
Cells(s2_son, "ı") = Sheets("sevki").Cells(i, "h").Value
Cells(s2_son, "j") = Sheets("sevki").Cells(i, "ı").Value
Cells(s2_son, "k") = Sheets("sevki").Cells(i, "j").Value
Cells(s2_son, "l") = Sheets("sevki").Cells(i, "k").Value
Cells(s2_son, "m") = Sheets("sevki").Cells(i, "l").Value
Sheets("sevki").Select
End If
Next
Sheets("hasila").Select
Cells(1, 1).Select
End Sub
Sub raporla2()
Sheets("hasila").Select
'Range("e7:m35").ClearContents

Sheets("delal").Select
For i = 6 To Cells(35, "a").End(xlUp).Row
If Cells(i, "n").Value = "n" Or Cells(i, "n").Value = Chr(252) Then
rn1 = "(b" + LTrim(Str(i)) + ":l" + LTrim(Str(i)) + ")"
Sayfa1_veri1 = Cells(i, "d").Value
Sayfa1_veri2 = Cells(i, "e").Value
Sayfa1_veri3 = Cells(i, "f").Value
Sayfa1_veri4 = Cells(i, "g").Value
Sayfa1_veri5 = Cells(i, "h").Value
Sayfa1_veri6 = Cells(i, "ı").Value
Sayfa1_veri7 = Cells(i, "j").Value
Sayfa1_veri8 = Cells(i, "k").Value
Sayfa1_veri9 = Cells(i, "l").Value

Sheets("hasila").Select
s2_son = Cells(65536, "b").End(xlUp).Row + 1

Cells(s2_son, "e") = Sheets("delal").Cells(i, "d").Value
Cells(s2_son, "f") = Sheets("delal").Cells(i, "e").Value
Cells(s2_son, "g") = Sheets("delal").Cells(i, "f").Value
Cells(s2_son, "h") = Sheets("delal").Cells(i, "g").Value
Cells(s2_son, "ı") = Sheets("delal").Cells(i, "h").Value
Cells(s2_son, "j") = Sheets("delal").Cells(i, "ı").Value
Cells(s2_son, "k") = Sheets("delal").Cells(i, "j").Value
Cells(s2_son, "l") = Sheets("sevki").Cells(i, "k").Value
Cells(s2_son, "m") = Sheets("sevki").Cells(i, "l").Value
Sheets("sevki").Select
End If
Next
Sheets("hasila").Select
Cells(1, 1).Select
End Sub

Sub raporla3()
Sheets("hasila").Select
'Range("e7:m35").ClearContents

Sheets("gokhan").Select
For i = 6 To Cells(35, "a").End(xlUp).Row
If Cells(i, "n").Value = "n" Or Cells(i, "n").Value = Chr(252) Then
rn1 = "(a" + LTrim(Str(i)) + ":l" + LTrim(Str(i)) + ")"
Sayfa1_veri1 = Cells(i, "d").Value
Sayfa1_veri2 = Cells(i, "e").Value
Sayfa1_veri3 = Cells(i, "f").Value
Sayfa1_veri4 = Cells(i, "g").Value
Sayfa1_veri5 = Cells(i, "h").Value
Sayfa1_veri6 = Cells(i, "ı").Value
Sayfa1_veri7 = Cells(i, "j").Value
Sayfa1_veri8 = Cells(i, "k").Value
Sayfa1_veri9 = Cells(i, "l").Value

Sheets("hasila").Select
s2_son = Cells(65536, "b").End(xlUp).Row + 1

Cells(s2_son, "e") = Sheets("gokhan").Cells(i, "d").Value
Cells(s2_son, "f") = Sheets("gokhan").Cells(i, "e").Value
Cells(s2_son, "g") = Sheets("gokhan").Cells(i, "f").Value
Cells(s2_son, "h") = Sheets("gokhan").Cells(i, "g").Value
Cells(s2_son, "ı") = Sheets("gokhan").Cells(i, "h").Value
Cells(s2_son, "j") = Sheets("gokhan").Cells(i, "ı").Value
Cells(s2_son, "k") = Sheets("gokhan").Cells(i, "j").Value
Cells(s2_son, "l") = Sheets("gokhan").Cells(i, "k").Value
Cells(s2_son, "m") = Sheets("gokhan").Cells(i, "l").Value
Sheets("gokhan").Select
End If
Next
Sheets("hasila").Select
Cells(1, 1).Select
End Sub

Esas projemin kodlarıdır yalnız biçimlendirmeler soru dosyasıyla aynıdır.

 

[asmirk]

Arkadaşlar konuda bayağı bir ilerleme kayıd etmeme rağmen sadece tek bir noktada takılmaktayım. Sevgili ustalarım bana bu konuda yardımcı olurlarsa sevinirim.Sorunumu örnekte daha detaylı açıkladım.

Saygılarımla...

 

[asmirk]

Bir türlü işin içinden çıkamadım

 

[asmirk]

Arkadaşlar Esas sorun nedenimi ve yapmak istediğimi Tam olarak açıklayıcı bir şekilde Örnekte anlattım.Bir aktarma tuşuna basarak bütün sheetlerde ki çekleri hasila adlı shet'e sıradan aktarması konusunda Yardımcı olabilirseniz çok sevineceğim

Saygılarımla..

 

[tahsinanarat]

Sn. asmirk dosyanız ekte

İstediğiniz doğrultuda yapmaya çalıştım, inceleyin varsa eksiklikler tekrar bakalım. Kolay gelsin