Sıra numarasını girince, karşılık verileri getirme..

[EKREM1661]

Saygıdeğer hocam, ekli dosyada görsel olarak belirttim.. OCAK sayfası P6130 aralığına, Sayfa1 deki "B6:B130" sıra numaralarını girince;
Sayfa1 "H ,I ,J" sütunlardaki karşılıklarını, OCAK sayfası "S, T, U" sütun karşılıklarına getiriyor..
Burdaki sorun; rakamı silince, getirilen verileri hemen kaldıramıyor, tüm sayıları sayarak bekletiyor. Buna bir çözüm bula bilir miyiz ?

 

[Muzaffer Ali]

Merhaba.

Ocak adlı sayfanın kod sayfasındaki kodları silin yerine aşağıdakileri kopyalayın.

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim Bul As Range
    If Not Intersect(Target, Range("P:P")) Is Nothing Then
        With Worksheets("Sayfa1")
            Set Bul = .Range("B:B").Find(what:=Target.Text, lookat:=xlWhole)
            If Bul Is Nothing Then
                Target.Offset(0, 3).Value = "Bulunamadı."
            Else
                Target.Offset(0, 3).Value = .Cells(Bul.Row, "H")
                Target.Offset(0, 4).Value = .Cells(Bul.Row, "I")
                Target.Offset(0, 5).Value = .Cells(Bul.Row, "J")
            End If
        End With
    End If
End Sub

 

[EKREM1661]

Hocam, çok çok teşekkür ederim ve ziyadesiyle makbule geçti.. Bir de, ARALIK sayfası F6:F130 aralığını Sayfa1 F6:F130 aralığına getirmede hata alıyorum. Sizin için kolay olacak bu makroyu da belirtirseniz başka bir sorunum kalmıyor..
Hoşça kalınız ve hayırlı ramazanlar diliyorum..

 

[osman06turgut]

Merhaba;
makro dener misiniz..

Sub KopyalaAralik()
Dim wsKaynak As Worksheet
Dim wsHedef As Worksheet

Set wsKaynak = ThisWorkbook.Sheets("ARALIK")
Set wsHedef = ThisWorkbook.Sheets("Sayfa1")

wsKaynak.Range("C6:F130").Copy
wsHedef.Range("C6").PasteSpecial Paste:=xlPasteValues

Application.CutCopyMode = False

MsgBox "Veriler başarıyla kopyalandı!", vbInformation, "İşlem Tamamlandı"
End Sub

 

[EKREM1661]

Osman bey, çok teşekkürler.. Halledilmiş oldu.. Muzaffer bey'in de senin de ilgi/alakanıza minnettarım.. Hoşça kalınız..

 

[osman06turgut]

Teşekkürler. İyi Forumlar.

 

[Muzaffer Ali]

İkinci sorunuz için daha kısa ve hızlı bir kod yazılabilir.

Sub Kopyala()
    Sheets("Sayfa1").Range("F6:F130").Value = Sheets("ARALIK").Range("F6:F130").Value
End Sub

 

[EKREM1661]

Teşekkürler Muzaffer bey, dediğiniz gibi tek satırla daha hızlı çözüm..

 

[EKREM1661]

Muzaffer hocam, düşündüm de; yukarıdaki dosyada;
Sayfa1 deki verileri, formüllerle OCAK, ŞUBAT, MART.... diye devam eden12 sayfaya aktarıyorum.
Ancak Sayfa1 de bazen bilmeyenlern (satır sil ekle gibi) işlemlerinde başvuru formüllerini bozuyor..
Bunu makro ile aktarsak..

Sayfa1 de (B, C. D. E) sütunların B6:B130 aralığı, diğer ay sayfalarına aktarımı..
Başvuru adresleri de hep aynıdır.. B6:E130 aralığı..
Yani;
(Sıra No, Cinsi, TCO No. Plaka No) 6.ncı satırdan itibaren, ay sayfalarına 6.ncı satırdan itibaren aktaran makro..

 

[Muzaffer Ali]

1- 2 numaralı mesajdaki kodu BuÇalışmaKitabı adlı kod sayfasına uygun şekilde değiştirdim. P sütununa bir şey yazdığınız sayfanın adı ay isimlerinden biri ise o sayfada kod otomatik çalışır. Yani kodu her sayfaya tek tek yazmaya gerek yok.
2- 9 numaralı mesajdaki isteğinizi gerçekleştirdim. Sayfa1 de bulunan "Aylara Aktar" butonuna tıkladığınızda çalışacaktır.
3- Bunu istememiştiniz ama G ve O sütunlarında bulunan formülleri de "Aylara Aktar" butonuna tıkladığınızda çalışacak şekilde düzenledim.