Tarihe göre başka sayfadan veri çekme

[enesyildiz]

ekteki dosyada anlatmaya çalıştım. Yardımlarınızı bekliyorum. Şimdiden teşekkür ederim.

 

[Necdet]

Merhaba,

Aşağıdaki kodları bir modüle kopyalayıp çalıştırın. Tam kontrol yapmadım, deneyiniz.

Sub TakvimDoldur()

    Dim ShTakvim    As Worksheet, _
        ShData      As Worksheet, _
        c           As Range, _
        d           As Range, _
        IlkAdres    As String, _
        i           As Integer, _
        Yil         As Long, _
        Ay          As String, _
        Gun         As String, _
        Bayrak      As Boolean

    Set ShTakvim = Sheets("Takvim")
    Set ShData = Sheets("Data")
    
    Application.ScreenUpdating = False
    
    For i = 1 To ShData.Cells(Rows.Count, "A").End(3).Row
        Yil = Year(ShData.Cells(i, "A"))
        Ay = Format(ShData.Cells(i, "A"), "mmmm")
        Gun = Format(Day(ShData.Cells(i, "A")), "00")
        Bayrak = False
        With ShTakvim.Range("B:B")
            Set c = .Find(Yil, LookIn:=xlValues)
            If Not c Is Nothing Then
                IlkAdres = c.Address
                Do
                    If c.Offset(0, 1) = Ay Then
                        Set d = c.CurrentRegion.Find(Gun, LookIn:=xlValues)
                        If Not d Is Nothing Then
                            Bayrak = True
                            d.Offset(1, 0) = d.Offset(1, 0) & " " & ShData.Cells(i, "C") & " " & ShData.Cells(i, "D")
                        End If
                    End If
                    Set c = .FindNext(c)
                Loop While (Not c Is Nothing And c.Address <> IlkAdres) And Bayrak = False
            End If
        End With
        
    Next i
    
    Application.ScreenUpdating = True
    
    MsgBox "Takvime Yazılmıştır....", vbInformation, "www.excel.web.tr, Necdet YEŞERTENER"
    
End Sub

 

[enesyildiz]

denedim çalıştı ama ben farklı bi takvim datası yükledim aynı satır sütünlara, sadece aralık ayındaki verileri çekti.

 

[Necdet]

Veriyi görmeden ne diyebilirim?

Örnek dosyanızda farklı tarihleri denedim yazdı.

 

[enesyildiz]

d.Offset(1, 0) = d.Offset(1, 0) & " " & ShData.Cells(i, "C") & " " & ShData.Cells(i, "D")

ben diğer takvimi ekleyip çalıştırdığımda bir dizinin bölümünü değiştiremezsiniz hatası veriyor. Debug dediğimde üstteki kod sarı işaretli çıkıyor.

 

[Necdet]

O hücre birleştirilmiş bir hücre midir?