Son Satırı İlgili Sayfaya Aktarma

[Rheago]

Merhaba arkadaşlar. Forumda işime yarayabilecek bir excel kitabı buldum.Kitaptaki Makroya şu şekilde ekleme yapmak istiyorum. Şuanki hali ile Sayfa1 deki en alttaki veriyi Sayfa2 ye taşıyor. Ama ben şu şekilde yapmak istiyorum. Eğerki A sütununun son verisinde İLK yazıyorsa, İLK adlı sayfaya, ORTA yazıyorsa, ORTA isimli sayfaya, SON yazıyorsa SON adlı sayfaya diğer o satırdaki diğer değerlerle beraber taşısın istiyorum. Eğer ki A sütunundaki değerler yanlış yazıldıysa uyarsın istiyorum. Şimdiden teşekkür ederim.

 

[EmrExcel16]

Merhaba arkadaşlar. Forumda işime yarayabilecek bir excel kitabı buldum.Kitaptaki Makroya şu şekilde ekleme yapmak istiyorum. Şuanki hali ile Sayfa1 deki en alttaki veriyi Sayfa2 ye taşıyor. Ama ben şu şekilde yapmak istiyorum. Eğerki A sütununun son verisinde İLK yazıyorsa, İLK adlı sayfaya, ORTA yazıyorsa, ORTA isimli sayfaya, SON yazıyorsa SON adlı sayfaya diğer o satırdaki diğer değerlerle beraber taşısın istiyorum. Eğer ki A sütunundaki değerler yanlış yazıldıysa uyarsın istiyorum. Şimdiden teşekkür ederim.

Merhaba , Önceki kodları dikkate almadan aşağıdaki gibi deneyiniz.

Sub Emr_Aktar()

Dim AktfSyf, Sayf, SonSatS1, SonSatS2, i

    SonSatS1 = Cells(Rows.Count, 1).End(xlUp).Row
    Sayf = Cells(SonSatS1, 1).Value
    AktfSyf = ActiveSheet.Name
    
    For i = 1 To Sheets.Count
        If Sheets(i).Name <> AktfSyf And Sheets(i).Name = Sayf Then
            SonSatS2 = Sheets(Sayf).Cells(Sheets(Sayf).Rows.Count, 1).End(xlUp).Row
            Range(Sheets(Sayf).Cells(SonSatS2, 1), Sheets(Sayf).Cells(SonSatS2, 10)).Value = Range(Cells(SonSatS1, 1), Cells(SonSatS1, 10)).Value
            Akt = True
        End If
    Next
    
    If Akt Then
    MsgBox "Aktarim Basariyla Gerceklesti"
    Else
    MsgBox "Aktarim Ilgili Sayfa bulunamadigi Icim Gerceklesmedi"
    End If

End Sub

 

[Rheago]

Merhaba , Önceki kodları dikkate almadan aşağıdaki gibi deneyiniz.

Sub Emr_Aktar()

Dim AktfSyf, Sayf, SonSatS1, SonSatS2, i

    SonSatS1 = Cells(Rows.Count, 1).End(xlUp).Row
    Sayf = Cells(SonSatS1, 1).Value
    AktfSyf = ActiveSheet.Name
   
    For i = 1 To Sheets.Count
        If Sheets(i).Name <> AktfSyf And Sheets(i).Name = Sayf Then
            SonSatS2 = Sheets(Sayf).Cells(Sheets(Sayf).Rows.Count, 1).End(xlUp).Row
            Range(Sheets(Sayf).Cells(SonSatS2, 1), Sheets(Sayf).Cells(SonSatS2, 10)).Value = Range(Cells(SonSatS1, 1), Cells(SonSatS1, 10)).Value
            Akt = True
        End If
    Next
   
    If Akt Then
    MsgBox "Aktarim Basariyla Gerceklesti"
    Else
    MsgBox "Aktarim Ilgili Sayfa bulunamadigi Icim Gerceklesmedi"
    End If

End Sub

Hocam elinize sağlık. Fakat şöyle bir sorun var. Tekrar eklemeye çalışınca diğer sayfaların bir alt satırına eklemiyor. Hep 1. satıra ekliyor.

 

[EmrExcel16]

Hocam elinize sağlık. Fakat şöyle bir sorun var. Tekrar eklemeye çalışınca diğer sayfaların bir alt satırına eklemiyor. Hep 1. satıra ekliyor.

SonSatS2 = Sheets(Sayf).Cells(Sheets(Sayf).Rows.Count, 1).End(xlUp).Row bu satırı aşağıdaki gibi değiştirip dener misiniz.

SonSatS2 = Sheets(Sayf).Cells(Sheets(Sayf).Rows.Count, 1).End(xlUp).Row + 1

 

[Rheago]

SonSatS2 = Sheets(Sayf).Cells(Sheets(Sayf).Rows.Count, 1).End(xlUp).Row bu satırı aşağıdaki gibi değiştirip dener misiniz.

SonSatS2 = Sheets(Sayf).Cells(Sheets(Sayf).Rows.Count, 1).End(xlUp).Row + 1

Emeğinize sağlık hocam. Çok teşekkür ederim. İşime yaradı.

 

[EmrExcel16]

Emeğinize sağlık hocam. Çok teşekkür ederim. İşime yaradı.

Rica ederim , iyi çalışmalar.