Belirli Sütunların Aktarılması

Katılım
22 Temmuz 2005
Mesajlar
228
Excel Vers. ve Dili
Excel-2003 Türkçe
Altın Üyelik Bitiş Tarihi
03.03.2021
Slm Arkadaşlar Üstadlar Belirli veriye göre belirli sütunların aktarılmasını ve alttoplam alınması makro kodu lazım. Yardımcı olabilirmisiniz.

Örnek: Sayfa1 in A2>0 ise B2, C2, H2,I2,K2.M2 hücrelerinin Sayfa2 ye katarılması A2 den başlayarak sırasıyla sütunlara aktarılmas. Sayfa1 in son dolu satırına kadar aktarmasını ve Sayfa2 de işlem bittikten sonra son satıra toplam almasını istiyorum. yardımcı olursanız sevinirm. şimdiden herkese teşekkürler. kolay gelsin üstadlar.
 

Orion1

Uzman
Uzman
Katılım
1 Mart 2005
Mesajlar
22,254
Excel Vers. ve Dili
Win7 Home Basic TR 64 Bit

Ofis-2010-TR 32 Bit
Küçük bir örnek dosya yollamanız doğru olacaktır.:cool:
 

veyselemre

Özel Üye
Katılım
9 Mart 2005
Mesajlar
3,650
Excel Vers. ve Dili
Pro Plus 2021
Kod:
Sub dene()
Set s1 = Sheets("Sayfa1")
Set s2 = Sheets("Sayfa2")
a = Array(2, 3, 8, 9, 11, 13)
sat = 1
For x = 2 To [a65536].End(3).Row
    If Cells(x, 1) > 0 Then
        sat = sat + 1
        For y = 1 To 6
            s2.Cells(sat, y) = s1.Cells(x, a(y - 1))
        Next
    End If
Next x

For y = 1 To 6
    s2.Cells(sat + 1, y) = WorksheetFunction.Sum(Range(s2.Cells(2, y), s2.Cells(sat, y)))
Next
End Sub
 
Katılım
22 Temmuz 2005
Mesajlar
228
Excel Vers. ve Dili
Excel-2003 Türkçe
Altın Üyelik Bitiş Tarihi
03.03.2021
teşekkürler veyselemre ellerine sağlık üstadım.
 
Katılım
22 Temmuz 2005
Mesajlar
228
Excel Vers. ve Dili
Excel-2003 Türkçe
Altın Üyelik Bitiş Tarihi
03.03.2021
Birde toplam alımında belirli sütunların toplamının alınmasını nasıl yaparız.
Örnek: C, K, H sütunlarının toplanmasını istiyoruz.
 

veyselemre

Özel Üye
Katılım
9 Mart 2005
Mesajlar
3,650
Excel Vers. ve Dili
Pro Plus 2021
Kod:
Sub dene()
Set s1 = Sheets("Sayfa1")
Set s2 = Sheets("Sayfa2")

a = Array(2, 3, 8, 9, 11, 13)
sat = 1
For x = 2 To [a65536].End(3).Row
    If Cells(x, 1) > 0 Then
        sat = sat + 1
        For y = 1 To 6
            s2.Cells(sat, y) = s1.Cells(x, a(y - 1))
        Next
    End If
Next x
a = Array(2, 3, 5)
For y = 0 To 2
    s2.Cells(sat + 1, a(y)) = WorksheetFunction.Sum(Range(s2.Cells(2, a(y)), s2.Cells(sat, a(y))))
Next
End Sub
 
Katılım
22 Temmuz 2005
Mesajlar
228
Excel Vers. ve Dili
Excel-2003 Türkçe
Altın Üyelik Bitiş Tarihi
03.03.2021
teşekkürler üstad ellerine sağlık tam istediğim gibi
 
Üst