Mevcut makroya ilave. Diğer sayfadan veri çekme .

[Filose]

Merhaba,

Elimdeki makro dosyasına küçük bir ilave yapmak istiyorum. ama beceremedim. Ekteki dosyada belirtilen V.TAKVİMİ sayfasından LİSTE sayfasındaki E2 hücresine yazılan ilgili ayın bilgisini LİSTE sayfasındaki D9 hücresinden başlayarak alt alta yazsın..

Formül ve resim kopyalama işlemiyle yaptım ama iyi olmadı makro ile yazılmasını rica ediyorum.

Herkese teşekkür ediyorum.

 

[Ziynettin]

Liste sayfası kod penceresine,

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address(0, 0) = "E2" Then
On Error Resume Next
    ay = MonthName(Target.Value)

    If Err <> 0 Then
        MsgBox "Hatalı ay girişi.", vbCritical
        Exit Sub
    End If


    With Sheets("V.Takvimi")
        Dim rg As Range, tb As Range
        Set rg = .Range("B6:T56")
        Set tb = .Range(rg.Find(ay, , xlValues, xlWhole).Address).Offset(2).Resize(10)
    End With
    
    If Not tb Is Nothing Then
        With Range("D9:K19")
            .Borders.ColorIndex = xlNone
            .ClearContents
            .Interior.ColorIndex = xlNone
        End With
        sat = 9
        For i = 1 To 10
            If tb(i, 1) <> "" Then
                s = s + 1
                Cells(sat, 4) = tb(i, 1)
                sat = sat + 1
            End If
        Next i
        If s > 0 Then
            Cells(9, 4).Resize(s, 8).Borders.Color = rgbSilver
        End If
    Else
        MsgBox "Ay bulunamadı.", vbExclamation
    End If
On Error GoTo 0
End If
End Sub

 

[Necdet]

Merhaba,

Kendi mantığımla dosyayı düzenledim ve kodları ona göre yazdım.
Çok çok zorunlu olmadığı sürece hücre birleştirmeye karşıyım.
Dolayısıyla kodlar daha sade olmakta.

Aşağıdaki kodlar Liste sayfasının kod bölümünde olmalı.

Private Sub Worksheet_Change(ByVal Target As Range)

Dim c As Range

If Intersect(Target, [C2]) Is Nothing Then Exit Sub

With Application
    .EnableEvents = False
    .ScreenUpdating = False
End With

With Sayfa2.Cells
    Set c = .Find(Target.Value, LookIn:=xlValues)
    If Not c Is Nothing Then
        c.CurrentRegion.Offset(1).Resize(10, 1).Copy Range("D6")
    Else
        MsgBox Range("C2") & " AYINA AİT VERİ BULUNMADI...."
    End If
End With

With Application
    .EnableEvents = True
    .ScreenUpdating = True
End With

End Sub

 

[Filose]

Merhaba Ziynettin Bey,
Öncelikle ilginize teşekkür ediyorum. Makro çalışıyor sadece Gelen yerin (LİSTE sayfası) hücrelerin formatını değiştirmese olur mu?
Ellerinize sağlık çok teşekkür ediyorum.

Ayrıca Necdet beye de çok teşekkür ediyorum. Kodları virüs uyarısı verdiği için henüz kontrol edemedim.

Sağlık diliyorum.

 

[Filose]

Necdet Bey Merhaba,
Yazdığınız makro çalışıyor sorun yok. Yalnız bunu elimdeki hazır olan başka bir makroya eklemem gerekiyor. Benim için en zor o zaten. Orada maalesef birleştirilmiş hücreler var. Ayrıca ay adları değil ay sayıları girilmesi gerekir.

Teşekkür eder saygılar sunuyorum.

 

[Haluk]

Makrosuz bir alternatif ekli dosyadadır.....

.

 

[Filose]

Haluk Bey Merhaba,

Bu şekil de de kullanabilirim. Ancak E2 Hücresinde ay ismi yerine ay sayısı olabilir mi? Birde Eylül'den sonra "veri yok" diyor.

Bendeki dosyaya kopyalayacağım için Liste sayfasında yazdığınız formüler dışında başka neyi alacağım. Lütfen acemiliğime bağışlayın.

İlginiz ve uğraşınız için çok teşekkür ediyorum.

 

[Haluk]

Eylül ve sonraki ayların da dahil edildiği dosya 6 No'lu mesajda...

Formülü biraz inceleyin, halledersiniz......

.

 

[Filose]

Necdet Bey merhaba,

Yazdığınız kodları kendime göre düzenledim. Ay ile değil sayı ile olarak değiştirdim. Çünkü makro içinde BS5 değeri bir çok yerde sayı olarak tanımlanmış.

Ancak benim LİSTE sayfasında kodlara ilave edemedim hata veriyor. Çalışan dosyayı ekledim. (Kısmi olarak eklerini eklemedim) yani makro çalışıyor. Sizden ricam LİSTE sayfasına ekleyebilirmisiniz?

Saygılar,

 

[Filose]

Necdet Bey merhaba,

Yazdığınız kodları kendime göre düzenledim. Ay ile değil sayı ile olarak değiştirdim. Çünkü makro içinde BS5 değeri bir çok yerde sayı olarak tanımlanmış.

Ancak benim LİSTE sayfasında kodlara ilave edemedim hata veriyor. Çalışan dosyayı ekledim. (Kısmi olarak eklerini eklemedim) yani makro çalışıyor. Sizden ricam LİSTE sayfasına ekleyebilirmisiniz?

Saygılar,

Necdet bey tekrar merhaba, müsait olduğunuzda bakabilirseniz çok memnun olurum. Saygıyla,

 

[Filose]

Tekrar merhaba arkadaşlar, öncelikle ilginize çok teşekkür ediyorum. Burada paylaştığınız bilginin değeri çok büyük. Sayenizde binlerce kişi buradan fayda sağlıyor. Bazen de benim gibi acemiler sizi yoruyor lütfen kusura bakmayın.

İlişikte gönderdiğim dosyada, V.TAKVİMİ'nde sayfa kodu bu sayfada çalışıyor sorun yok. Benim rica ettiğim LİSTE sayfasında bulunan kodlara ilave edemedim. (Bu kodlar uzundu kısalttım ve bu haliyle de çalışıyor)

Herkese saygılar sunuyorum.