Veri Aktar, Diğer Sayfaya, Tarihe Göre

[1Al2Ver]

Merhaba,

Mevcut kod ile C2'deki tarihe göre "MEVCUTLAR" sayfasına veri aktarıyorum,

Sub KAYIT()
    Range("C2:C14").Select
    Selection.Copy
    Sheets("MEVCUTLAR").Select
    Range("A2").Select
    Application.Goto Reference:="R2000C1"
    Selection.End(xlUp).Select
    ActiveCell.Offset(1, 0).Range("A1").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=True
    Range("A2").Select
    Sheets("KAYIT").Select
    Range("C2").Select
    Application.CutCopyMode = False
    Range("C3,C4,C6:C13").ClearContents
End Sub

İstenen ;

"MEVCUTLAR" sayfasındaki çizelgeyi yeniden düzenledim ve C2'deki tarihi H1'e alarak, verileri "MEVCUTLAR" sayfasındaki çizelgeye, hergünü alt alta gelecek şekilde kayıt etmek,

Teşekkür ederim.

 

[YUSUF44]

Aşağıdaki gibi deneyin:

Sub KAYIT()
    Set s1 = Sheets("KAYIT")
    Set s2 = Sheets("MEVCUTLAR")
    
    yeni = s2.Cells(Rows.Count, "A").End(3).Row + 1
    
    s2.Cells(yeni, "A") = s1.[H1]
    
    s1.Range("C3:C4").Copy: s2.Cells(yeni, "B").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=True
    
    s1.Range("C6:C14").Copy: s2.Cells(yeni, "D").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=True
    Application.CutCopyMode = False
    s1.Range("C3,C4,C6:C13").ClearContents
    s1.Activate
    s1.[H1].Select
    
End Sub

 

[1Al2Ver]

Sayın YUSUF44 merhaba,

Sorunum çözülmüştür, ilginize teşekkür ederim.

Saygılarımla.