Verileri sıralama

[shenko]

Sagıdeğer leventm emeğiniz çok teşekkürederim. Çok güzel olmuş. Sizden ricam aşağıda vermiş olduğum makronun, yazılmış verileri tekrar yazmamasını sağlayabilirmisiniz???

Sub aktar()
For a = 5 To [a65536].End(3).Row
Set s = Sheets("" & Cells(a, "c"))
say = WorksheetFunction.CountA(s.[c:c]) + 4
s.Cells(say, "a") = Cells(a, "a")
s.Cells(say, "b") = Cells(a, "b")
s.Cells(say, "c") = Cells(a, "c")
s.Cells(say, "d") = Cells(a, "d")
s.Cells(say, "e") = Cells(a, "e")
s.Cells(say, "f") = Cells(a, "f")
s.Cells(say, "g") = Cells(a, "g")
s.Cells(say, "h") = Cells(a, "h")
Next
MsgBox "VERİLER AKTARILDI"
End Sub

 

[shenko]

Saygıdeğer üstad yukarıda sorduğum sorunun cevabını buldum. Size çok teşekkürederim.
Bu veri aktarma olayını tarihe göre yapmak mumkunmu acaba mesela gg.aa.yy fotmatındaki tarihi sene sene ayırıp başka sayfalara aktarma yapmak???

Sayenizde çok şeyler öğreniyoruz! Herşey için Teşekkürler!

 

[Levent Menteşoğlu]

Tarihin alınacağı sütun dosyanızda "C" sütunu olduğunu düşünürsek, bu durumda eklediğim dosyadaki kodu aşağıdaki ile değiştirerek deneyin. İlk kod içinde aşağıdaki kırmızı renkli satır değiştirilmiştir.

[vb:1:77d427fed9]Dim ad As String
Sub aktar()
On Error Resume Next
Application.ScreenUpdating = False
Set s1 = Sheets("ana sayfa")
For a = 3 To s1.[a65536].End(3).Row
ad = Year(s1.Cells(a, "c"))
For c = 1 To Sheets.Count
If Sheets(c).Name = ad Then GoTo 10
Next
Sheets(Sheets.Count).Copy After:=Sheets(Sheets.Count)
Sheets(Sheets.Count).Name = ad
[b5:g65536,c2].ClearContents
10 Sheets("ana sayfa").Select
Set s2 = Sheets("" & ad)
say = WorksheetFunction.CountIf(s2.[b5:b65536], s1.Cells(a, "a"))
If say = 1 Then GoTo 20
say = WorksheetFunction.CountA(s2.[b5:b65536]) + 5
For b = 1 To 6
s2.Cells(say, b + 1) = s1.Cells(a, b)
Next
20 Next
MsgBox "VERİLER AKTARILDI"
End Sub
[/vb:1:77d427fed9]

 

[shenko]

Değerli ustad leventm;

Tarih olayını aşağıdaki makroya nasıl uygulayabilirim?? Tarihler C sütununa yazılıyor!

For a = 5 To [a65536].End(3).Row
Set s = Sheets("" & Cells(a, "c"))
say = WorksheetFunction.CountA(s.[c:c]) + 3
s.Cells(say, "a") = Cells(a, "a")
s.Cells(say, "b") = Cells(a, "b")
s.Cells(say, "c") = Cells(a, "c")
s.Cells(say, "d") = Cells(a, "d")
s.Cells(say, "e") = Cells(a, "e")
s.Cells(say, "f") = Cells(a, "f")
s.Cells(say, "g") = Cells(a, "g")
s.Cells(say, "h") = Cells(a, "h")
Next
MsgBox "VERİLER AKTARILDI"
End Sub

 

[Levent Menteşoğlu]

Set s = Sheets("" & Cells(a, "c"))

Yukarıdaki satırı aşağıdaki ile değiştirerek deneyin. Netice alamazsanız dosyanızı ekleyin.

Set s = Sheets("" & year(Cells(a, "c"))) veya Set s = Sheets(year(Cells(a, "c")))