günlere aktarma

[abdullahss]

Merhaba hayırlı ramazanlar.Yapmak istediğim (y )sütunundaki isme göre (z) sütunundan değeri alıp tarih aralığına göre diğer sayfaya aktarmak. İstenilen sayfada isim ve yerleri değişe biliyor.

Sub Getir()
    Dim str As Integer, a As Integer, bul As Range
    For str = 2 To Range("A65536").End(3).Row
        For a = 3 To Cells(1, Columns.Count).End(1).Column
             If Sayfa1.Range("A1").Value = Cells(1, a) And Sayfa1.Cells(str, 1) <> "" Then
                Set bul = Sayfa1.Columns(1).Find(Cells(str, 1), , , 1)
                If Not bul Is Nothing Then
                    Cells(str, a) = bul.Offset(0, 26).Value
                End If
            End If
        Next a
    Next str
    str = Empty: a = Empty: Set bul = Nothing
End Sub

 

[YUSUF44]

Aşağıdaki makroyu deneyiniz:

Sub aktar()
Set s1 = Sheets("GUNLUK")
son = s1.Cells(Rows.Count, "Y").End(3).Row
For i = 1 To Sheets.Count
    If Sheets(i).Name <> s1.Name Then
        If IsDate(Sheets(i).[B1]) Then
            If Month(Sheets(i).[B1]) = Month(s1.[A1]) And Year(Sheets(i).[B1]) = Year(s1.[A1]) Then
                songun = Sheets(i).Cells(Rows.Count, "A").End(3).Row
                For urun = 3 To son
                    If WorksheetFunction.CountIf(Sheets(i).Range("A1:A" & songun), s1.Cells(urun, "Y")) > 0 Then
                        sat = WorksheetFunction.Match(s1.Cells(urun, "Y"), Sheets(i).Range("A1:A" & songun), 0)
                        Sheets(i).Cells(sat, Day(s1.[A1]) + 1) = s1.Cells(urun, "Z")
                    End If
                Next
                i = Sheets.Count
            End If
        End If
    End If
Next
End Sub

 

[abdullahss]

teşekkür ederim Yusuf bey bu şekilde oldu