Sayfalardaki Değerleri Kopyalama

[Seyit Tiken]

Herkese Selamlar,
Çalışma Kitabında onlarca sayfa var. Bu sayfalardaki B4'ler(B4 hücrelerindeki değerler) ile H4'ler(H4 hücrelerindeki değerler) kopyalanıp,"Ã?zel Yapıştır"dan,"DEÐERLERİ", "Rapor" adındaki çalışma sayfasına yapıştırılacak. Yani Çalışma Kitabındaki sayfaların B4 hücreleri, "Rapor"adındaki sayfanın A1 hücresine; H4 hücreleri de B1 hücresine "Ã?zel Yapıştır"dan, "Değerleri" olarak yapıştırılacak. Herhangi bir sayfada H4 hücresindeki değer "0" sıfır ise, o sayfayı kopyalamasın. Yani "Rapor" adındaki sayfaya kopyalamasın. Teşekkür ediyorum.

 

[Levent Menteşoğlu]

Aşağıdaki kodu deneyin.

[vb:1:f3ff5d0015]Sub kopyala()
For a = 1 To Sheets.Count
If Sheets(a).Name = "Rapor" Then GoTo 10
If Sheets(a).[h4] <> 0 Then
c = c + 1
Sheets("Rapor").Cells(c, 1) = Sheets(a).[b4]
Sheets("Rapor").Cells(c, 2) = Sheets(a).[h4]
End If
10 Next
End Sub[/vb:1:f3ff5d0015]

 

[Seyit Tiken]

Levent Bey Merhabalar,
Cevabınızdan dolayı teşekkür ediyorum. Herhalde yetersiz açıklamışım. Kodları kendime uyarlayamadm. Ã?rnek dosyayı da gönderiyorum. Soruyu sade bir şekilde gene soruyorum: Bir Çalışma Kitabımız var. İlk sayfada "Rapor" isimli sayfamız var. Ve "Ali", "Veli", "Selami" Vs. isimli sayfalar. Bu sayfaların, "Ali" isimli sayfanın B4 hücresindeki değer, "Rapor" isimli sayfanın A2 hücresine, aynı sayfanın("Ali" isimli sayfa) I4 hücresindeki değer "Rapor" isimli sayfanın B2 hücresine "değer" olarak yapıştırılacak. "Ayşe" isimli sayfada "Rapor" isimli sayfanın bir önceki satırın altına yapıştırsın. Yani sayfalardaki veriler "Rapor" isimli sayfanın satırlarına alt alta gelecek şekilde kopyalasın-yapıştırsın. Yani Çalışma Kitabının bir sayfasındaki değerler "Rapor" isimli sayfanın bir satırına yapıştırılacak. Bir sayfa, bir satır.
Sayfalarda (I4 hücrelerinde) değer "0" sıfır ise kopyalama yapmasın.
Teşekkür ediyorum.

 

[Levent Menteşoğlu]

Aşağıdaki kodu Rapor sayfasında bir butona bağlayarak çalıştırın.

[vb:1:78328e8a4e]Sub kopyala()
Sheets("rapor").[a2:b65536].ClearContents
For a = 1 To Sheets.Count
If Sheets(a).Name = "Rapor" Then GoTo 10
If Sheets(a).[i4] <> 0 Then
c = c + 1
Sheets("Rapor").Cells(c + 1, 1) = Sheets(a).[b4]
Sheets("Rapor").Cells(c + 1, 2) = Sheets(a).[i4]
End If
10 Next
End Sub
[/vb:1:78328e8a4e]