Sayfa1'deki verileri Sayfa2'ye aktarma konusunda acilen yardım lütfen

[bulentozsahin]

Hayırlı günler,

Ekli dosya sayfa1'deki Satış Miktarı sütunundaki rakamları her gün günleştirip Sayfa2'ye aktarmak istiyorum.

Bu konuda acilen yardıma ihtiyacım. Yardım edin lütfen.

Saygılarımla.

 

[Orion1]

Ekli dosyyaı inceleyiniz.

Sub aktar()
Dim s2 As Worksheet, sut As Range, sat As Range
Sheets("Sayfa1").Select
If Range("D1").Value = "" Then
    MsgBox "D1 Hücresi boş.D1 hücresine bir tarih giriniz..!!", vbCritical, "DİKKAT"
    Exit Sub
End If
Application.ScreenUpdating = False
Set s2 = Sheets("Sayfa2")
Set sut = s2.Range("B1:IV1").Find(Range("D1").Value, , xlValues, xlWhole)
If Not sut Is Nothing Then
    For i = 2 To Cells(65536, "A").End(xlUp).Row
        Set sat = s2.Range("A2:A65536").Find(Range("A" & i).Value, , xlValues, xlWhole)
        If Not sat Is Nothing Then
            s2.Cells(sat.Row, sut.Column) = Cells(i, "B").Value
        End If
    Next
End If
Application.ScreenUpdating = True
MsgBox "İşem tamamlandı..!!", vbOKOnly + vbInformation, Application.UserName
End Sub

 

[bulentozsahin]

Sn. Evren Gizlen

Sayın Evren Gizlen,

İlginize çok teşekkür ederim. Gerçekten çok güzel olmuş. Affınıza sığınarak olması gereken dosyayı gönderiyorum. (Denedim beceremedim)

Yardımlarınız için çok teşekkürler.