Verileri başka sayfaya aktarma

[hacimurat71]

Merhabalar,

Kolay gelsin. Süper site ve her konuda çok yardımı dokundu.
Sitede aradım fakat tam istediğim bir makro bulamadım. Burada bulduğum makroyu uyguladım, fakat hata 13 ve 91 veriyor. Sanırım makro tam olmamış.

Uyguladım makro şöyle. Ekte bir proje listesi var. Satıcılar kendi projelerini giriyorlar ve sonuçlanmadığı zaman, G sütununda "continues" diye yazıyor. Eğer bir proje kazanıldığı zaman, G sütun "win" olarak değiştiriliyor ve "WIN" sayfasına aktarıyor ve 1.ci sayfadan siliniyor. Aynısı "lost" yapıldığı zaman içinde geçerlidir. Ayrıca yanlışlıkla "win" yapıp ve "WIN" sayfasına aktarınca, buradan "lost" yapıp, tekrar bu satırı "LOST" sayfasına geçiyor. Buraya kadar herşey normal. Fakat bu aktarmalar yapılırken, her defasında hata 13 (bazen 91) veriyor. Bu makroyu düzenleyebilirmisiniz? Umarım istediğimi tam olarak anlatabildim.

Çok teşekkürler.
Murat

 

[asi_kral]

Merhaba
Kitabınızdaki tüm kodları silin ve bu kodu kod bölümünde bulunan tüm çalışma kitabı ( thisworkbook ) bölümüne kopyalayın ve deneyin.

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Dim S1 As Worksheet, STR As Long
Application.ScreenUpdating = False
Application.EnableEvents = False
If Intersect(Target, Range("G2:G" & Rows.Count)) Is Nothing Then _
Application.EnableEvents = True: Application.ScreenUpdating = True: Exit Sub
If Target = "WIN" Or Target = "LOST" Or Target = "wın" Or Target = "lost" Then
Set S1 = Sheets(Target.Text)
STR = S1.Range("A" & Rows.Count).End(xlUp).Row + 1
Range("A" & Target.Row & ":J" & Target.Row).Copy
S1.Range("A" & STR).PasteSpecial (xlPasteAll)
Range("A" & Target.Row & ":J" & Target.Row).Delete
End If
Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub

 

[hacimurat71]

Asi_kral çok teşekkürler. Hata kodu vermiyor ve istenilen şekilde çalışıyor. Şimdi başka sorun çıktı. Satıcılar arasında flitreleme yaptığımda ve burada WIN/LOST yaptığımda, tüm satırı sileyimmi diye soruyor. Diğer sayfaya kopyalama yapıyor fakat bu soruya iptal dediğiniz zaman, o satırı silmiyor ama diğer sayfaya atmış oluyor. Bunuda çözersek herşey tam istediğim gibi, süper olmuş olur.

Teşekkürler.
Murat

 

[asi_kral]

Asi_kral çok teşekkürler. Hata kodu vermiyor ve istenilen şekilde çalışıyor. Şimdi başka sorun çıktı. Satıcılar arasında flitreleme yaptığımda ve burada WIN/LOST yaptığımda, tüm satırı sileyimmi diye soruyor. Diğer sayfaya kopyalama yapıyor fakat bu soruya iptal dediğiniz zaman, o satırı silmiyor ama diğer sayfaya atmış oluyor. Bunuda çözersek herşey tam istediğim gibi, süper olmuş olur.

Teşekkürler.
Murat

Siz kitaptaki tüm kodları silmediniz sanırım. Ben diğer sorunu dosyayı görmeden çözemem. Lütfen dosyanızı gönderin ona göre bakalım.

 

[hacimurat71]

Tüm kodları sildim ve göndermiş olduğunuz kodu tüm çalışma kitabına ekledim. Sorunsuz çalıştı. Fakat dediğim gibi, satıcılarda filtreleme yaptığımda, örnek olarak Murat seçtiğimde, sadece Murat satıcının projeleri çıkıyor. Buradan WIN/LOST yaptığımda, diğer sayfaya aktarıyor ve "tüm satır silinsinmi" uyarısı çıkıyor. Evet dediğim zaman, sorun yok. Fakat iptal dediğim zaman, her iki sayfada gözükmüş oluyor.

Ekte güncel dosyam mevcut.

 

[asi_kral]

Kodu bununla değiştirir misiniz_?

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Dim S1 As Worksheet, STR As Long
Application.ScreenUpdating = False
Application.EnableEvents = False
If Intersect(Target, Range("G2:G" & Rows.Count)) Is Nothing Then _
Application.EnableEvents = True: Application.ScreenUpdating = True: Exit Sub
If Target = "WIN" Or Target = "LOST" Or Target = "wın" Or Target = "lost" Then
Set S1 = Sheets(Target.Text)
STR = S1.Range("A" & Rows.Count).End(xlUp).Row + 1
Range("A" & Target.Row & ":J" & Target.Row).Copy
S1.Range("A" & STR).PasteSpecial (xlPasteAll)
Application.DisplayAlerts = False
Range("A" & Target.Row & ":J" & Target.Row).Delete
Application.DisplayAlerts = True
End If
Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub

 

[hacimurat71]

Ustadım çok teşekkürler. Harika oldu. Ellerine sağlık.

İyi akşamlar.
Murat

 

[asi_kral]

Ustadım çok teşekkürler. Harika oldu. Ellerine sağlık.

İyi akşamlar.
Murat

Kolay Gelsin.

 

[bestof42]

Merhabalar ben sayfa1 deki A Sütunun içindeki verileri sayfa2 de A sütunun içindeki verilerle karşılaştırarak, ortak olan satırları sayfa 3 de göstermek istiyorum. Makro yardımlarınızı rica ederim