200 sayfanın aynı hücresinden ana sayfaya veri almak

[mpinal]

Arkadaşlar benim 201 sayfalık bir dosyam var 200 adet aynı sayfa (şirket kartları) ve bu sayfaların her birinin örnegin a1 hücresini liste şeklinde ana sayfada görmek istiyorum.yani ana sayfada a1 hücresine =1!k1 b1 hücresine =2!k1 c1 hücresine =3!k1 şeklinde girişlerle bunu başarıyorum ama tam 200 sayfa ve aynı şekilde ana sayfadaki listeme her sayfasının 8 değişik yerinden bilgi çekmeliyim. yani uzun lafın kısası 1600 defa yukarıdaki formülü yazmalıyım sürükle bırak ile denedim fakat olmadı (office 2003) anasayfa a1 hücresine=1!$k$1 --- b1 hücresine =2!$k$1 yazıp sürükledim olmadı acaba bu işin kolay yolu varmıdır? ilgilenen arkadaşlara teşekkür ederim.

 

[SEMAY77]

Merhaba mpinal,

Dosyanı gönderirmisin.

 

[mpinal]

Merhaba mpinal,

Dosyanı gönderirmisin.

arkadaşım dosyamın boyutu çok büyük bu yüzden aynı sıkıntıyı yaşadığım 70 sayfalık bir dosyamı gönderiyorum.burada da sıkıntı aynı ana sayfaya belirli yerlerden veri çekmeliyim.ilgilenebilirseniz sevinirim.

 

[tahsinanarat]

ilk satırdaki formüllerinizi bu şekilde sabitleyin
='1'!$J$253, ='1'!$k$253, ='1'!$l$253......................='1'!$p$253
Sonra formülleri aşağıya doğru istediğiniz satır sayısı kadar çoğaltınız.
Sayfa isimlerini değiştirmek için ise satırı komple seçerek bul değiştirden
bul kısmına ='1
değiştir kısmına ='2
yazıp tümünü değiştirin, diğer satırlar içinde aynı işlemi yapıp bir kereye mahsus bu zahmete girdiğiniz takdirde istediğiniz sonucu ulaşacaksınız. Benim aklıma gelen en pratik yol bu.
Umarım kodla veya formülle çözüm olursa bizde öğrenmiş oluruz.

 

[mpinal]

ilk satırdaki formüllerinizi bu şekilde sabitleyin
='1'!$J$253, ='1'!$k$253, ='1'!$l$253......................='1'!$p$253
Sonra formülleri aşağıya doğru istediğiniz satır sayısı kadar çoğaltınız.
Sayfa isimlerini değiştirmek için ise satırı komple seçerek bul değiştirden
bul kısmına ='1
değiştir kısmına ='2
yazıp tümünü değiştirin, diğer satırlar içinde aynı işlemi yapıp bir kereye mahsus bu zahmete girdiğiniz takdirde istediğiniz sonucu ulaşacaksınız. Benim aklıma gelen en pratik yol bu.
Umarım kodla veya formülle çözüm olursa bizde öğrenmiş oluruz.

Sayın tahsinanarat benim kullandığım yöntemden 1 basamak daha iyisini söylediniz bu yüzden şu anda en iyi çözüm sizinki teşekkür ederim ben bir elim mouse da diğeri klavyede otomatiğe bağlamış gibi tek tek değiştiriyordum şu anda 200 sayfalık bir dosyada yaklaşık iş yükünü 10 da 1 e indirdiniz teşekkür ederim umarım daha kolayı vardır.

 

[tahsinanarat]

Sn. mpinal, aslında buna benzer bir çözüm önerisi sitede hatırlıyor gibiyim, ancak şu an için aramalarımda bulamadım, eğer bulursan sizinle burada paylaşırım. Bende merak ettim şimdi

 

[SEMAY77]

Merhaba mpinal

Aşağıdaki kodu kopyalayıp Yeni bir modül aç ve buraya yapıştır.Kaç sayfa verin olursa olsun hepsini Ana sayfaya aktarır.Arzu edersen formüllüde aktarabilirim.

İyi çalışmalar!

Sub Aktar()
Dim i As Integer, j As Integer
Dim KacSayfa As Integer
Application.ScreenUpdating = False
KacSayfa = Sheets.Count
Sheets("ANA").Select
For i = 1 To KacSayfa - 1
Sheets(i + 1).Select
tarih = Worksheets(i + 1).Cells(3, 3)
Gıder = Worksheets(i + 1).Cells(253, 9)
Cek = Worksheets(i + 1).Cells(253, 10)
Acık_hesap = Worksheets(i + 1).Cells(253, 11)
Personel = Worksheets(i + 1).Cells(253, 12)
Gıder2 = Worksheets(i + 1).Cells(253, 13)
Cek2 = Worksheets(i + 1).Cells(253, 14)
Acık_hesap2 = Worksheets(i + 1).Cells(253, 15)
Personel2 = Worksheets(i + 1).Cells(253, 16)

Sheets("ANA").Select
Cells(4, 3).Select
Selection.End(xlDown).Select
ActiveCell.Offset(1, -1).Select

Satir = ActiveCell.Row
Sutun = ActiveCell.Column
Worksheets("ANA").Cells(Satir, Sutun) = tarih
Worksheets("ANA").Cells(Satir, Sutun + 1) = Gıder
Worksheets("ANA").Cells(Satir, Sutun + 2) = Cek
Worksheets("ANA").Cells(Satir, Sutun + 3) = Acık_hesap
Worksheets("ANA").Cells(Satir, Sutun + 4) = Personel
Worksheets("ANA").Cells(Satir, Sutun + 5) = Gıder2
Worksheets("ANA").Cells(Satir, Sutun + 6) = Cek2
Worksheets("ANA").Cells(Satir, Sutun + 7) = Acık_hesap2
Worksheets("ANA").Cells(Satir, Sutun + 8) = Personel2
Next i
Sheets("ANA").Select
Cells(6, 1).Select
End Sub

 

[mpinal]

Merhaba mpinal

Aşağıdaki kodu kopyalayıp Yeni bir modül aç ve buraya yapıştır.Kaç sayfa verin olursa olsun hepsini Ana sayfaya aktarır.Arzu edersen formüllüde aktarabilirim.

İyi çalışmalar!

Sub Aktar()
Dim i As Integer, j As Integer
Dim KacSayfa As Integer
Application.ScreenUpdating = False
KacSayfa = Sheets.Count
Sheets("ANA").Select
For i = 1 To KacSayfa - 1
Sheets(i + 1).Select
tarih = Worksheets(i + 1).Cells(3, 3)
Gıder = Worksheets(i + 1).Cells(253, 9)
Cek = Worksheets(i + 1).Cells(253, 10)
Acık_hesap = Worksheets(i + 1).Cells(253, 11)
Personel = Worksheets(i + 1).Cells(253, 12)
Gıder2 = Worksheets(i + 1).Cells(253, 13)
Cek2 = Worksheets(i + 1).Cells(253, 14)
Acık_hesap2 = Worksheets(i + 1).Cells(253, 15)
Personel2 = Worksheets(i + 1).Cells(253, 16)

Sheets("ANA").Select
Cells(4, 3).Select
Selection.End(xlDown).Select
ActiveCell.Offset(1, -1).Select

Satir = ActiveCell.Row
Sutun = ActiveCell.Column
Worksheets("ANA").Cells(Satir, Sutun) = tarih
Worksheets("ANA").Cells(Satir, Sutun + 1) = Gıder
Worksheets("ANA").Cells(Satir, Sutun + 2) = Cek
Worksheets("ANA").Cells(Satir, Sutun + 3) = Acık_hesap
Worksheets("ANA").Cells(Satir, Sutun + 4) = Personel
Worksheets("ANA").Cells(Satir, Sutun + 5) = Gıder2
Worksheets("ANA").Cells(Satir, Sutun + 6) = Cek2
Worksheets("ANA").Cells(Satir, Sutun + 7) = Acık_hesap2
Worksheets("ANA").Cells(Satir, Sutun + 8) = Personel2
Next i
Sheets("ANA").Select
Cells(6, 1).Select
End Sub

ilginiz için teşekkür ederim semay77 ancak sizden iki ricam var 1. benim bu kodu diğer dosyalarımada uygulaya bilmem için değiştirebileceğim yerlerle ilgili bir açıklama yaparmısınız.ikincisi formüllede yapabilirseniz onuda öğrenmek isterim.ilginiz ve emeğiniz için teşekkür ederim.

 

[SEMAY77]

Merhaba mpinal,

Kodu değişiklik yapmadan uygulayabilirsin.Sadece sayfa numaraların 200-300 veya daha fazlası olması farketmez.Tek yapman gereken kaç sayfan varsa Ana sayfadaki satır sayısını sayfa sayısına göre ayarlaman.Formüllü olarakta ileve edeceğim.

İyi çalışmalar!

 

[SEMAY77]

Merhaba

Aşağıdaki kodu kopyalayıp yapıştırırsan formülleriyle birlikte aktarırsın.Sizin esas isteğiniz buydu.

İyi çalışmalar!

Sub Aktar()
Dim i As Integer
Dim KacSayfa As Integer
Application.ScreenUpdating = False
KacSayfa = Sheets.Count
Sheets("ANA").Select
Range("B6").Select
Range(Selection, Selection.End(xlDown)).Select
Range(Selection, Selection.End(xlToRight)).Select
Selection.ClearContents
Range("A5").Select
For i = 1 To KacSayfa - 1
Sheets(i + 1).Select
Range("C3").Select
Selection.Copy
Sheets("ANA").Select
Cells(4, 3).Select
Selection.End(xlDown).Select
ActiveCell.Offset(1, -1).Select
ActiveSheet.Paste Link:=True
Sheets(i + 1).Select
Range("I253253").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("ANA").Select
Cells(4, 3).Select
Selection.End(xlDown).Select
ActiveCell.Offset(1, 0).Select
ActiveSheet.Paste Link:=True
Range("A4").Select
Next i
Sheets("ANA").Select
Cells(6, 1).Select
End Sub

 

[mpinal]

Merhaba

Aşağıdaki kodu kopyalayıp yapıştırırsan formülleriyle birlikte aktarırsın.Sizin esas isteğiniz buydu.

İyi çalışmalar!

Sub Aktar()
Dim i As Integer
Dim KacSayfa As Integer
Application.ScreenUpdating = False
KacSayfa = Sheets.Count
Sheets("ANA").Select
Range("B6").Select
Range(Selection, Selection.End(xlDown)).Select
Range(Selection, Selection.End(xlToRight)).Select
Selection.ClearContents
Range("A5").Select
For i = 1 To KacSayfa - 1
Sheets(i + 1).Select
Range("C3").Select
Selection.Copy
Sheets("ANA").Select
Cells(4, 3).Select
Selection.End(xlDown).Select
ActiveCell.Offset(1, -1).Select
ActiveSheet.Paste Link:=True
Sheets(i + 1).Select
Range("I253253").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("ANA").Select
Cells(4, 3).Select
Selection.End(xlDown).Select
ActiveCell.Offset(1, 0).Select
ActiveSheet.Paste Link:=True
Range("A4").Select
Next i
Sheets("ANA").Select
Cells(6, 1).Select
End Sub

çok teşekkür ederim semay77 yukarıdaki kodunuz gayet başarılı bir şekilde çalıştı kodu bir düğmeye atadım ve çalıştırdımtüm formüller bir anda belirdi ana sayfamda bunu bir kalıpp olarak kullanacağım.Size son bir sorum olacak benim ana sayfaya bilgi çektiğim satırlar her sayfanın i253 ile p253 arası dolayısıyla Range("I253253").Select kısmını değiştirmem yeterlimi bir başka dosyada kullanmam için?

 

[SEMAY77]

Kesinlikle yeterlidir.

İyi çalışmalar!

 

[tahsinanarat]

Altarnatif olsun

Ben dosyamı hazırladığımda SN. SEMAY77 nin yapmış olduğu dosyayı gördüm, çok güzel olmuş, bizimki yanında sönük kalır ama olsun bayağı uğraşmıştım boşa gitmesin, altarnatif olsun diye ekliyorum, belki başka örneklerde ışık tutar.

 

[mpinal]

Ben dosyamı hazırladığımda SN. SEMAY77 nin yapmış olduğu dosyayı gördüm, çok güzel olmuş, bizimki yanında sönük kalır ama olsun bayağı uğraşmıştım boşa gitmesin, altarnatif olsun diye ekliyorum, belki başka örneklerde ışık tutar.

Teşekkürler Sayın tahsinanarat ; Emeğiniz için teşekkür ederim sizlerin sayesinde çok daha değişik ve güzel çözümler öğreniyorum sizin kodunuzuda şimdi inceledim 3 ayrı makro yapmışsınız bunuda excel defterime kaydediyorum.Eğer zaman ayırabilirseniz yazdığınız makroları biraz en azından başka bir dosyaya uyarlarken nerelere dikkat etmeliyim bu konuda bir kaç satır açıklama yazarsanız beni çok mutlu edersiniz sizin çözümünüzüde kaydederim sayenizde yeni şeyler öğrendim çok teşekkür ederim.Amacım sizlere bişeyler yaptırıp unutmak değil sizin değerli bilgilerinizden birşeyler öğrenmek bu yüzden zaman ayırıp açıklama yazarsanızsizin makrolarınızıda çalışır öğrenirim.

 

[tahsinanarat]

Bir hafta kadar bilgisayardan uzk olacağım, cepden de kodları göremiyorum,dönünce yazmaya çalışırım. Bende sizler gibi meraklisiyim saadece