dolu olanı aktar kod yardımı

[tamer060]

Merhabalar şöyle bir sıkıntım var
"E8"den "E50" ye kadar olan dolu satırlar A sütunu ile B sütununda yazanlar ile al.
Sayfa 2 deki E,F,G sütunlarındaki boş satırlara ekle. buna nasıl bir kod yazabiliriz. yardımcı olurmusunuz?

 

[İhsan Tank]

merhaba

Private Sub CommandButton1_Click()
Dim MyRng As Range
Dim NoA1 As Long

Set sh1 = Sheets("Sayfa1")
Set sh2 = Sheets("Sayfa2")

NoA1 = sh1.Cells(65536, 1).End(xlUp).Row

For Each MyRng In sh1.Range("A1:A" & NoA1)
NoA2 = sh2.Cells(65536, 1).End(xlUp).Row + 1
If MyRng <> "m.cinsi" And MyRng <> "" Then
sh2.Range("A" & NoA2) = MyRng
sh2.Range("B" & NoA2) = MyRng.Offset(0, 1)
sh2.Range("C" & NoA2) = MyRng.Offset(0, 2)
sh2.Range("D" & NoA2) = MyRng.Offset(0, 3)
End If
Next
End Sub

bu kodu denermisiniz ( olmaz ise örnek dosya ekleyiniz ) kod alıntıdır.

 

[tamer060]

sayın çılgın bu kodda a sütununda dolu olanı aktarıyo benim istediğim "sayfa1 den E8"den "E50" ye kadar olan dolu satırlar A sütunu ile B sütununda yazanlar ile birlikte al.
Sayfa 2 deki E,F,G sütunlarındaki boş satırlara ekle."
buna nasıl bir kod yazabiliriz. yukarıdaki kodda yapmaya çalıştım ama beceremedim.

 

[İhsan Tank]

örnek dosya eklemenizi rica ediyorum daha çabuk yanıt alırsınız ve daha fazla görüş bildirilebilir ezbere birşeyler yapmayalım.

 

[tamer060]

dosya ektedir.

 

[tamer060]

sayın çılgın dosyayı ekledim. ve örnek yaptım bunu kod ile nasıl yaparız

 

[Orion1]

Dosyanız ektedir.

Sub dolu_aktar()
Dim i As Long, sat As Long, sh As Worksheet, sat2 As Long
Set sh = Sheets("Sayfa2")
Sheets("Sayfa1").Select
Application.ScreenUpdating = False
sat2 = sh.Cells(65536, "E").End(xlUp).Row + 1
sat = Cells(65536, "A").End(xlUp).Row
For i = 3 To sat
    If Cells(i, "E").Value <> "" Then
        If sat >= 65533 Then
            MsgBox "Sayfa2de satır doldu.Kayıtların tamamı aktarılmadı", vbCritical, "UYARI"
            Application.ScreenUpdating = True
            Exit Sub
        End If
        sh.Cells(sat2, "E").Value = Cells(i, "A").Value
        sh.Cells(sat2, "F").Value = Cells(i, "B").Value
        sh.Cells(sat2, "G").Value = Cells(i, "E").Value
        sat2 = sat2 + 1
        Cells(i, "E").ClearContents
    End If
Next i
sh.Select
Application.ScreenUpdating = True
MsgBox "İşlem Tamamdır" & vbLf & "evrengizlen@hotmail.com", vbOKOnly + vbInformation, "E V R E N"
End Sub

 

[tamer060]

evren bey peki sayfa2 ye aktarınca boş satıra ekliyerek aktarması lazım, yani her aktarmada bir öncek sayfa 2 ye aktarmanın alt satırına ekliyecek ve aktardağını sayfa 1 de sadece E sütunundan silmesi lazım bu kunuda da yardımcı olabilirseniz çok memnun olcağım

 

[Orion1]

evren bey peki sayfa2 ye aktarınca boş satıra ekliyerek aktarması lazım, yani her aktarmada bir öncek sayfa 2 ye aktarmanın alt satırına ekliyecek ve aktardağını sayfa 1 de sadece E sütunundan silmesi lazım bu kunuda da yardımcı olabilirseniz çok memnun olcağım

Zaten sayfa2'ye aktarıyor ve alt alta aktarıyor.Siz neyi farklı istiyorsunuz?sorunuz net değil.Ayrıca aktardığı yerdende E sütunundaki hücreyide silmesinimi istiyorsunuz?

 

[tamer060]

evren bey aktarma işleminde 1. aktarmayı yaptıktan sonra sayfa1 deki aktardığı E sütunundaki verileri silmesini istiyorum
diğer sorun ise diyelim 101,102,103 kodlarına çıkış miktarlarını girerek aktar dedik, aktarmayı yapıyor yalnız tekrar aynı sutunlara aynı değerleri yazıp aktar dediğim zaman sayfa 2 deki diğer aktardığını silerek aktarıyor! bunu silmeyip alt satıra aktarmasını istiyorum . Bunu yapabilirseniz çok memnum olurum Evren bey Saygılarımla

 

[Orion1]

evren bey aktarma işleminde 1. aktarmayı yaptıktan sonra sayfa1 deki aktardığı E sütunundaki verileri silmesini istiyorum
diğer sorun ise diyelim 101,102,103 kodlarına çıkış miktarlarını girerek aktar dedik, aktarmayı yapıyor yalnız tekrar aynı sutunlara aynı değerleri yazıp aktar dediğim zaman sayfa 2 deki diğer aktardığını silerek aktarıyor! bunu silmeyip alt satıra aktarmasını istiyorum . Bunu yapabilirseniz çok memnum olurum Evren bey Saygılarımla

Dosyayı güncelledim.7 numaralı mesajdan indirip deneyiniz.

 

[tamer060]

Sayın Evren Bey zamna ayırdığınız ve ilgilendiğiniz için ne kadar teşekkür etsem az kalır. Hakkınız zor ödenir çok sağolun

 

[Orion1]

Sayın Evren Bey zamna ayırdığınız ve ilgilendiğiniz için ne kadar teşekkür etsem az kalır. Hakkınız zor ödenir çok sağolun

Rica ederim.
İyi çalışmalar.