Hücre yönlendirme

[nirvanarapeme]

Arkadaşlar bir sheet de ki aynı satır daki bir grup veriyi makro yardımıyla başka bir sheet e taşımak istiyorum. Konuyla ilgili en son açılmış konu şu linkte mevcut

http://www.excel.web.tr/f50/hucre-yonlendirme-nasyl-oluyor-t80504.html

Bu linkte bu işlem için şu kod önerilmiş ancak bu kodda aktarılacak veriler diğer sheet den silinebilirse işim çok kolaylaşacak, yani tam olarak aktarma değil de taşıma olayı... Kodda görebileceğiniz üzere "ClearContents" ifadesi var ama bu silme işlemi için olan bişey değil sanırım. Bu işlem için aşağıdaki kodu nasıl modifiye edebiliriz. Saygılarımla

Sub AKTAR()
Dim Hücre As Range
Dim Satır As Long
Satır = 2
Sheets("AKTARILAN").Range("A2:G65536").ClearContents
For Each Hücre In Selection
If Hücre.RowHeight <> 0 Then
With Sheets("AKTARILAN")
.Cells(Satır, 1) = Cells(Hücre.Row, 1)
.Cells(Satır, 2) = Cells(Hücre.Row, 4)
.Cells(Satır, 3) = Cells(Hücre.Row, 6)
.Cells(Satır, 4) = Cells(Hücre.Row, 7)
.Cells(Satır, 5) = Cells(Hücre.Row, 8)
.Cells(Satır, 6) = Cells(Hücre.Row, 12)
.Cells(Satır, 7) = Cells(Hücre.Row, 13)
End With
Satır = Satır + 1
End If
Next
MsgBox "İşleminiz tamamlanmıştır.", vbInformation
End Sub

 

[hamitcan]

Döngüden sonraki satıra aşağıdaki satırı ekleyip deneyin.

Cells.SpecialCells(xlCellTypeVisible).ClearContents

 

[nirvanarapeme]

Teşekkür ederim Hamit Bey. Ben bu kodu şu işlemi gerçekleştirmek için değiştirmek istiyorum aslında; "MTL" adındaki bir sayfanın N sütununun "EVET" yazısı gelen satırındaki yazıları "TE" adlı sayfanın en son boş satırına taşımak için nasıl değiştirmem gerekir. Bir kere daha konu açmıştım ama hiç cevap alamadım. Yardımcı olabilirseniz çok sevinirim. Saygılarımla

 

[Korhan Ayhan]

Merhaba,

Konuyla ilgili örnek dosyalar eklerseniz cevap almanız kolaylaşır.

 

[nirvanarapeme]

Teşekkürler örnek tabloyu açıklamalı bir şekilde ekledim.

 

[Korhan Ayhan]

Merhaba,

Aşağıdaki kodu MALZEME TALEP DATA (MTD) isimli sayfanızın kod bölümüne uygulayın.

EVET değerini seçtiğinizde kod otomatik çalışacaktır.

Option Explicit
 
Private Sub Worksheet_Change(ByVal Target As Range)
    Dim S1, BUL As Range, Satir
    
    On Error GoTo Son
    
    If Intersect(Target, Range("I2:I" & Rows.Count)) Is Nothing Then Exit Sub
    If Target = "EVET" Then
        Application.EnableEvents = False
        Set S1 = Sheets("ENVANTER (TE)")
        Set BUL = S1.Range("D:D").Find(Cells(Target.Row, "D"))
        If BUL Is Nothing Then
            Satir = S1.Cells(Rows.Count, 1).End(3).Row + 1
            S1.Range("A" & Satir & ":E" & Satir).Value = Range("A" & Target.Row & ":E" & Target.Row).Value
            S1.Cells(Satir, "F") = Cells(Target.Row, "G")
            Target.EntireRow.Delete
        Else
            S1.Cells(BUL.Row, "F") = S1.Cells(BUL.Row, "F") + Cells(Target.Row, "G")
            Target.EntireRow.Delete
        End If
    End If
 
Son: Application.EnableEvents = True
End Sub

 

[nirvanarapeme]

Teşekkürler Korhan Bey. Uygulama da şöyle bir sorun gördüm; MTD adlı sayfada EVET denildiğinde satırı siliyo ve diğer sayfaya taşıyor ancak bunu sadece bir kez yapıyor sonraki satıra EVET dediğim de MTD sayfasından siliniyo fakat diğer sayfaya aktarmıyor. Sorun ne olabilir acaba

 

[nirvanarapeme]

Tamam Korhan Bey özür dilerim barkodları aynı olduğunu farketmedim. Toplayarak gidiyormuş. Elinize sağlık çok teşekkür ederim