Sayfalardan Verİ Alma (aktarma)

Katılım
28 Eylül 2006
Mesajlar
37
Excel Vers. ve Dili
excel-2007 Türkçe
Merhaba arkadaşlar,

yaklaşık 300 e yakın sayfası olan bir çalışma kitabım var..
benim amacım bütün sayfalardaki hücrelerden alınan verilerle başka raporlar sayfası oluşturup veri almak.

örneğin

c3 = raporlar a1
c4 = raporlar a2
c7 = raporlar a3
c57= raporlar a4
gibi bütün sayfalardaki verileri bu şekilde alt alta gerekli satırlara aktarmak istiyorum..

bunula ilgili forumdaki veri aktarma konularını inceledim.. ama oralarda belirli bir hücre aralığı aktarılıyor.. bu yüzden tam bir çözüm üretemedim..

yardımlarınız için şimdiden teşekkür ederim..

saygılar,
 

Kemal Demir

Özel Üye
Katılım
29 Temmuz 2004
Mesajlar
2,108
Kod:
Sub aktar()
Sheets.Add , after:=Sheets(Sheets.Count)
'Yeni Sheet ekler ismi raporlar olur
ActiveSheet.Name = "Raporlar"
For x = 1 To Sheets.Count-1
say = WorksheetFunction.CountA(Sheets("Raporlar").Range("a1:a65536")) + 1
'1.Sheet itibari ile Tüm sheetlerin a1 değerini Rapor Sayfasının a kolonuna alt alta sıralar  umarım böyle birşey istediniz.
Sheets("raporlar").Cells(say, 1) = Sheets(x).Cells(1, 1)
Next
MsgBox ("Aktarma Bitti")
End Sub
 

Korhan Ayhan

Administrator
Yönetici
Admin
Katılım
15 Mart 2005
Mesajlar
42,263
Excel Vers. ve Dili
Microsoft 365 Tr-En 64 Bit
Selamlar,

Konuyla ilgili dosyanızın küçük bir örneği ile hangi hücreleri nereye aktarmak istediğinizi belirtirseniz yardımcı olabiliriz.
 

Kemal Demir

Özel Üye
Katılım
29 Temmuz 2004
Mesajlar
2,108
Kod:
Sub sayfalaraktar()
For x = 3 To Sheets.Count 
say = WorksheetFunction.CountA(Sheets("RAPORLAR").Range("c1:c65536")) + 1
Sheets("RAPORLAR").Cells(say, 3) = Sheets(x).Range("c3").Value
Sheets("RAPORLAR").Cells(say, 4) = Sheets(x).Range("c4").Value
Sheets("RAPORLAR").Cells(say, 5) = Sheets(x).Range("c5").Value
Sheets("RAPORLAR").Cells(say, 6) = Sheets(x).Range("c57").Value
Sheets("RAPORLAR").Cells(say, 7) = Sheets(x).Range("c58").Value
Sheets("RAPORLAR").Cells(say, 8) = Sheets(x).Range("c59").Value
Sheets("RAPORLAR").Cells(say, 9) = Sheets(x).Range("c60").Value
Sheets("RAPORLAR").Cells(say, 10) = Sheets(x).Range("c61").Value

Next
MsgBox ("Aktarma Bitti")
End Sub
Not:Raporlar Sayfası Ek'teki Dosya baz alınarak 2 Sheet'gore duzenlenmiştir.
 
Üst