Şartlı Kopyalama

[mbasaranyt]

Sitede Çok aradım (bazı eski mesajlar da silinmiş) fakat tam çözümü bulamadım.
Tablomdaki 0 dan büyük olanları makro ile aktarmak istiyorum

 

[Murat OSMA]

Şu kodları deneyiniz;

Sub Emre()
    Dim i As Range
    Dim sat As Integer
    sat = 2
    For Each i In Sayfa1.Range("G2:G9")
        If i.Value > 0 Then
           Sayfa1.Cells(i.Row, 1).Resize(, 7).Copy Sayfa2.Cells(sat, 1)
            sat = sat + 1
      End If
    Next i
    Set i = Nothing: sat = Empty
End Sub

 

[mbasaranyt]

Murat bey ilginize ve bilgilerinize çok teşekkür ederim.bu kodları siteden buldum ve daha öncede kullandım burada sayfa2 de olan bilgileri siliyor silmeden alt satıra kopyalamak istiyorum

 

[mbasaranyt]

Murat bey ilginize teşekkür ederim.Bu kodları denedim ancak sayfa2 deki eski bilgilerin üzerine kopyalıyor benim istediğim son satıra kopyalaması

 

[Murat OSMA]

Sabit bir tablonuz olduğunu düşündüm.

Sayfa2'deki TOPLAM satırını silin ve şu kodları deneyin...

Sub Emre()
    Dim i As Range
    For Each i In Sayfa1.Range("G2:G9")
        If i.Value > 0 Then
           Sayfa1.Cells(i.Row, 1).Resize(, 7).Copy Sayfa2.Range("a65536").End(3)(2, 1)
      End If
     Next i
    Set i = Nothing
End Sub

 

[mbasaranyt]

Evet Tablolarım sabit bu kodu maaş programında kullanacağım kayıt sayfalarım farklı olacak ama TOPLAM Satırı Mutlaka olacak.Bu Kodlar TOPLAM satırından sonra çalışıyor

 

[mbasaranyt]

sayfa2.Range("a65536")
sayfa2.Range("a9") olarak aldım oldu gibi

 

[Murat OSMA]

Olduysa iyi sorun yok demektir..

Ayrıca Toplam satırı için, şu kodları Sayfa2'nin kod sayfasına yazıp, toplam aldıracağınız satırda çift tıklayın;

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    Dim i As Integer
    Cells(Target.Row, 1) = "TOPLAM"
    Cells(Target.Row, 1).Font.Bold = True
    Cells(Target.Row, 7).Font.Bold = True
    Cells(Target.Row, 1).Resize(, 7).Interior.ColorIndex = 15
    Cells(Target.Row, 1).Resize(, 2).Merge
    Cells(Target.Row, 1).Resize(, 2).HorizontalAlignment = xlCenter
    For i = 2 To Range("G65536").End(3).Row
        Cells(Target.Row, "G") = WorksheetFunction.Sum(Range("G2:G" & i - 1), Cells(i, "G"))
    Next i
    i = Empty
    Cancel = True
End Sub

 

[mbasaranyt]

teşekkürler

 

[Murat OSMA]

Rica ederim, iyi günler...