Kaset Makro ile aylara kaydetme

[praxumit]

S.a cümleten. Ben Makro kaydet ile bi makro oluşturdum, gelir gider için. Gayet güzel bi şekilde çalışıyor ama resimde görüldüğü gibi Tarih bölümü örneğin 28/02/2015 olduğunda ŞUBAT Adlı sayfaya kaydetmesini istiyorum. Bunu yapabilmek mümkün mü ? Makroyu tek sayfada kullandığım için o sayfaya kaydediyor. Kullandığım makro ve resimler

Sub gelir()
'
' gelir Makro
'

'
    Range("A4:D4").Select
    Selection.Copy
    Application.WindowState = xlMinimized
    Application.WindowState = xlNormal
    Sheets("Aralık Önceki Yıl").Select
    ActiveWindow.SmallScroll Down:=42
    Range("A55").Select
    Selection.End(xlUp).Select
    ActiveCell.Offset(1, 0).Range("A1").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("A6").Select
    Sheets("Giriş").Select
    Range("A4:D4").Select
    Range("D4").Activate
    Application.CutCopyMode = False
    Selection.ClearContents
    Range("A5").Select
End Sub

 

[PLİNT]

S.a cümleten. Ben Makro kaydet ile bi makro oluşturdum, gelir gider için. Gayet güzel bi şekilde çalışıyor ama resimde görüldüğü gibi Tarih bölümü örneğin 28/02/2015 olduğunda ŞUBAT Adlı sayfaya kaydetmesini istiyorum. Bunu yapabilmek mümkün mü ? Makroyu tek sayfada kullandığım için o sayfaya kaydediyor. Kullandığım makro ve resimler

Merhaba
Aşağıdaki gibi deneyin.
[a4:j4] satırı devamlı veri giriş satırı;
Kodlarınızda [a4:d4] aktarılıyor; "J" sütununa kadar değilse aşağıdaki mavi bölümleri silip, "For a = 1 to 4" yapın

 [SIZE="2"]Sub gelir()
Set s1 = Sheets("Giriş")
Set s2 = Sheets(MonthName(Month([a4]), False))
x = s2.Cells(Rows.Count, 1).End(3).Row
s2.Range("a" & x + 1 & ":" & "d" & x + 1).Value = s1.Range("a4:d4").Value
[COLOR="Blue"]s2.Range("f" & x + 1 & ":" & "j" & x + 1).Value = s1.Range("f4:j4").Value[/COLOR]
For a = 1 To 10
s2.Cells(x + 1, a).NumberFormat = s1.Cells(4, a).NumberFormat
Next
s1.Range("a4:d4").Value = ""
[COLOR="Blue"]s1.Range("f4:j4").Value = ""[/COLOR]
End sub[/SIZE]

 

[praxumit]

Merhaba
Aşağıdaki gibi deneyin.
[a4:j4] satırı devamlı veri giriş satırı;
Kodlarınızda [a4:d4] aktarılıyor; "J" sütununa kadar değilse aşağıdaki mavi bölümleri silip, "For a = 1 to 4" yapın

 [SIZE="2"]Sub gelir()
Set s1 = Sheets("Giriş")
Set s2 = Sheets(MonthName(Month([a4]), False))
x = s2.Cells(Rows.Count, 1).End(3).Row
s2.Range("a" & x + 1 & ":" & "d" & x + 1).Value = s1.Range("a4:d4").Value
[COLOR="Blue"]s2.Range("f" & x + 1 & ":" & "j" & x + 1).Value = s1.Range("f4:j4").Value[/COLOR]
For a = 1 To 10
s2.Cells(x + 1, a).NumberFormat = s1.Cells(4, a).NumberFormat
Next
s1.Range("a4:d4").Value = ""
[COLOR="Blue"]s1.Range("f4:j4").Value = ""[/COLOR]
End sub[/SIZE]

Çok teşekkür ederim. ama bakiye bölümünü sildim j4 dü ı4 olacaktı. o zmanda formulleri #YOK diye yazmaya başladı bende çareyi kendi kaset makrodaki

Sheets("Aralık Önceki Yıl").Select

komutunu

Sheets(MounthName)(a4, false olarak değiştirdim ).Select oldu