Macro ile tarihleri sayfalara aktarma

[vimpir]

Merhaba arkadaşlar...
Benim sorunum excele girilen tarihli verileri aktar butonu ile ait oldukları sayfalar aktar mak önekte daha iyi anlayacaksınız yardımcı olursanız sevinirim .... Herkese iyi çalışmalar...

 

[Ömer]

Merhaba,

Module kopyalarak çalıştırınız..

Sub SayfalaraDağıt()
Dim sayfa As Variant, i As Long, son As Long
Dim Sg As Worksheet, Si As Worksheet
 
Set Sg = Sheets("geçmiş tarih")
Set Si = Sheets("ileri tarih")
Sheets("Veri").Select
 
For i = 2 To [A65536].End(3).Row
    If Cells(i, "A") < CDate("01.01.2011") Then
        son = Sg.[A65536].End(3).Row + 1
        Range("A" & i & ":G" & i).Copy Sg.Cells(son, "A")
    ElseIf Cells(i, "A") > CDate("31.12.2011") Then
        son = Si.[A65536].End(3).Row + 1
        Range("A" & i & ":G" & i).Copy Si.Cells(son, "A")
    ElseIf Format(Cells(i, "A"), "yyyy") = 2011 Then
        sayfa = Format(Cells(i, "A"), "mmmm")
        son = Sheets(sayfa).[A65536].End(3).Row + 1
        Range("A" & i & ":G" & i).Copy Sheets(sayfa).Cells(son, "A")
    End If
Next i
Range("A2:G65536").ClearContents
MsgBox "Aktarım Tamalandı.", vbInformation, Application.UserName
End Sub

.

 

[Necdet]

Merhaba,

Ömer bey hızlı davranmış, bende uğraşmıştım boşa gitmesin.

Sub Aktar()
    Dim Yıl     As Integer
    Dim i       As Long
    Dim j       As Long
    Dim Syf     As String
    
    Yıl = 2011
    
    Sheets("veri").Select
    Application.ScreenUpdating = False
    
    For i = 2 To Cells(Rows.Count, "a").End(3).Row
    
        If Year(Cells(i, "A")) < Yıl Then
            Syf = "geçmiş tarih"
        ElseIf Year(Cells(i, "A")) > Yıl Then
            Syf = "ileri tarih"
        Else
            Syf = Format(Cells(i, "A"), "mmmm")
        End If
        
        j = Sheets(Syf).Cells(Rows.Count, "A").End(3).Row + 1
        Range("A" & i & ":G" & i).Copy Sheets(Syf).Cells(j, "A")
        
    Next i
    
    Range("A2:G" & i).ClearContents
    
    Application.ScreenUpdating = True
    MsgBox "Veriler Aktarılmıştır...."
    
End Sub

 

[vimpir]

teşekkür ederim