Bir Sayfada Toplama!!

[shenko]

Elimde ayrı ayrı dört sayfa mevcut. Bu sayfaların hepsi ayrı ayrı makrolar çalışıyor. Şimdi yeni bir sayfa yapmak istiyorum ve bu sayfa diğer dört sayfamdaki dataları toplamak istiyorum.

Mesela Sheet1 deki a1:g100 arasındaki dataları alıp altına sheet2 deki a1:g100 arasındaki dataları yapıştırmasını ve onun altına sheet3 teki dataları yapıştırmasını son olarakta sheet4 teki dataları yapıştırmasını istiyorum. Yalnız bunu yaparken şunuda belirtmeliyim a1:g100 arasındaki butun satırlar dolu olmayabilir yani sheet1 deki a1:g10 a kadar dolu olabilir dolu olan satırları almasını istiyorum.

Böle bişi makrolarla yapmak mumkun olabilirmi??

Teşekkürler!!!

 

[AS3434]

Sn shenko

sn COST CONTROL un yazmış olduğu kodu söylediğiniz hücrelere uygulamaya çalıştım. İnşallah çalışır. (Bende çalışıyor , sizin dosyaya tam uygulayabildim mi bilmem)
En başa "YENİSAYFA" diye bir sayfa açın . aşağıdaki kodları butona bağlayın.


Sub VERİ_AKTAR()
Sheets("YENİSAYFA").Range("A1:G65536").ClearContents
For X = 1 To Worksheets.Count
Sheets(X).Select
Sheets(X).Range("A1:G" & Sheets(X).Range("A65536").End(xlUp).Row).Select
Selection.Copy
Sheets(X).Range("A1").Select
Sheets("YENİSAYFA").Select
Sheets("YENİSAYFA").Range("A65536").End(xlUp).Select
If ActiveCell.Address = "$A$1" Then
ActiveCell.Select
Else
ActiveCell.Offset(1, 0).Select
End If
ActiveSheet.Paste
Application.CutCopyMode = False
Next
Sheets("YENİSAYFA").Range("A1").Select
End Sub


Edit : sn. zafer daha kısa bir kod yazmış. Ama bu arada, bende denedim verdiğim kodlar çalışıyor.

 

[zafer]

Merhaba



Sub kopyala()
sayfa = Sheets.Count

For A = 1 To sayfa
son = Sheets("sayfa1").Cells(65536, 1).End(xlUp).Row
ad = Sheets(A).Name
If ad = "Sayfa1" Then GoTo DON
Sheets(ad).Select
For b = 1 To Cells(65536, 1).End(xlUp).Row
For c = 1 To 7
Sheets("sayfa1").Cells(b + son, c) = Cells(b, c).Value
Next
Next
DON:

Next
End Sub

 

[shenko]

Değerli üstadlar, İlginiz için çok teşekkür ederim. Bu verdiğiniz makroları kendi sayfama uygulamaya çalışıyorum. Takıldığım yerleri daha sonra size haber veririm.

Birde sizden ricam var, bu konu makrolarla ilgili olduğu için bu mesajı makro bölümüne taşımaya çalıştım ama şimdi aynı mesajdan ordada bir tane oldu. Lütfen yardım edermisiniz. Teşekkürler!!!

 

[zafer]

Merhaba

İsteğiniz üzere başlığı taşıdım. Boş olan makrolar bölümündeki başlığınızı sildim.

 

[shenko]

Evet sayın as3434 kodlarınız çok güzel çalışıyor. Çok teşekkür ederim.

Yalnız bu kodları şu şekilde sınırlamak mumkun mu acaba?

Sadece "YENİSAYFA" önündeki dört sayfayı kopyalayabilirmiyiz?

 

[shenko]

Çok teşekkür ederim sayın zafer.

 

[Korhan Ayhan]

Selamlar,

Kod içindeki ikinci satırdaki ifadeyi aşağıdaki ile değiştirirseniz istediğiniz gerçekleşecektir.

For X = 2 To 5

 

[AS3434]

Sn shenko
Excel.web.tr 'de saat 08:00/17:00 arası çalıştığım için son mesajınızı görmedim. Ama kodları yazan sn COST CONTROL sorunuza cevap vermiş. Küçük bir püf noktası olarak , eğer şekildeki gibi istiyorsanız
For X = 1 To 4 yapın.

 

[shenko]

Değerli üstadlar engin bilgilerinizi bizimle paylaştığınız için çok teşekkür ederiz. :bravo: