Dağıt-topla makrosu yardım lütfen

[Erdinç FIRTINA]

Değerli arkadaşlar,
Sayın Yurttaş'ın hazrlamış olduğu dağıt-topla makro kodlarının açıklanmasına ihtiyacım var.
Söz konusu makro ile verileri dağıtırken aynı zamanda tarihe göre veya isim, no vb. herhangi bir ölçüte göre sıralama yapabilir miyim?

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

 

[Merhum İdris SERDAR]

Değerli arkadaşlar,
Sayın Yurttaş'ın hazrlamış olduğu dağıt-topla makro kodlarının açıklanmasına ihtiyacım var.
Söz konusu makro ile verileri dağıtırken aynı zamanda tarihe göre veya isim, no vb. herhangi bir ölçüte göre sıralama yapabilir miyim?

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

Dosyadaki makroyu silin, yerine aşağıdakini koyun.

Sub TOPLA()
Dim wrk As Workbook
Dim sht As Worksheet
Dim trg As Worksheet
Dim rng As Range
Dim colCount As Integer
Set wrk = ActiveWorkbook
On Error Resume Next
Sheets("VERİ2").Select
ActiveWindow.SelectedSheets.Delete
Sheets("VERİ").Select
Sheets("VERİ").Select
Range("A1").Select
Range(Selection, Selection.End(xlToRight)).Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Cut
Range("K1").Select
ActiveSheet.Paste

For Each sht In wrk.Worksheets
On Error Resume Next


If sht.Name = "VERİ2" Then
MsgBox "There is a worksheet called as 'VERİ2'." & vbCrLf & _
"Please remove or rename this worksheet since 'VERİ2' would be" & _
"the name of the result worksheet of this process.", vbOKOnly + vbExclamation, "Error"
Exit Sub
End If
Next sht

Application.ScreenUpdating = False


Set trg = wrk.Worksheets.Add(After:=wrk.Worksheets(wrk.Worksheets.Count))
trg.Name = "VERİ2"
Set sht = wrk.Worksheets(1)
colCount = sht.Cells(1, 255).End(xlToLeft).Column
With trg.Cells(1, 1).Resize(1, colCount)
.Value = sht.Cells(1, 1).Resize(1, colCount).Value
.Font.Bold = True
End With

For Each sht In wrk.Worksheets

If sht.Index = wrk.Worksheets.Count Then
Exit For
End If

Set rng = sht.Range(sht.Cells(2, 1), sht.Cells(65536, 1).End(xlUp).Resize(, colCount))
trg.Cells(65536, 1).End(xlUp).Offset(1).Resize(rng.Rows.Count, rng.Columns.Count).Value = rng.Value2

Next sht

trg.Columns.AutoFit

Sheets("VERİ").Select
Range("K1").Select
Range(Selection, Selection.End(xlToRight)).Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Cut
Range("A1").Select
ActiveSheet.Paste
Range("A1").Select
Range("A1").Select
Range(Selection, Selection.End(xlToRight)).Select
Range(Selection, Selection.End(xlDown)).Select
ActiveWorkbook.Names.Add Name:="veritabanı", RefersToR1C1:="=VERİ!R1C1:R31C5"
ActiveWorkbook.Names.Add Name:="veritabanı", RefersToR1C1:="=VERİ!R1C1:R31C5"
Range("A1").Select
Sheets("VERİ2").Select
Range("K1:O1").Select
Selection.Cut
Range("A1").Select
ActiveSheet.Paste
Range("A1:E2").Select
Selection.Columns.AutoFit
Range("A1").Select


Application.ScreenUpdating = True

End Sub

...

 

[Erdinç FIRTINA]

Sayın Yurttaş'a çok teşekkürler!!!

Sayın Yurttaş,
yardımınız için çok teşekkür ederim. Sizin yaptıklarınızdan ve yardımlarınızdan dolayı bir şey talep etmeye bile çekiniyorum. Çünkü görüyorum ki sizler olmasanız yandık.

Ama dosyadaki makrolarda değişiklik yaptığımda error verdi.
Yani aktarırken de toplarken de tarihe göre sıralama yapmadı.
İsteğimi dosyam üzerinde anlatmıştım. İsteğime çözüm bulamasam da destekleriniz için gerçekten yürekten teşekkür ederim.

Ben bir eğitimci olarak öğretme ve öğrenme için verilen emeğin de destek için verilen emeğin de değerini çok iyi biliyorum. Sizlere çok teşekkür ederim.

 

[Merhum İdris SERDAR]

Sayın Yurttaş,
yardımınız için çok teşekkür ederim. Sizin yaptıklarınızdan ve yardımlarınızdan dolayı bir şey talep etmeye bile çekiniyorum. Çünkü görüyorum ki sizler olmasanız yandık.

Ama dosyadaki makrolarda değişiklik yaptığımda error verdi.
Yani aktarırken de toplarken de tarihe göre sıralama yapmadı.
İsteğimi dosyam üzerinde anlatmıştım. İsteğime çözüm bulamasam da destekleriniz için gerçekten yürekten teşekkür ederim.

Ben bir eğitimci olarak öğretme ve öğrenme için verilen emeğin de destek için verilen emeğin de değerini çok iyi biliyorum. Sizlere çok teşekkür ederim.

Çekinmenize gerek yok . Yardım edebiliyorsam. Ne mutlu bana.

Dosyanız ekte.

..

 

[Erdinç FIRTINA]

Sayın Yurttaş Teşekkürler!

Sayın Yurttaş,
Her şey için teşekkürler. Ama göndermiş olduğunuz dosyada da aktar ve topla makrosu çalışmasına rağmen istediğim tarihe göre sıralama olmuyor. Herhalde ben bir hata yapıyorum. Ya da anlatamadım. Yapmak istediğim şu.

Veriler aktarılırken açılan A sayfasında A sütunundaki verilerin küçükten büyüğe doğru tarihe göre, B sayfasında B sütunundaki verilerin küçükten büyüğe doğru tarihe göre sıralanması, topla makrosunda da VERİ2 sayfasındaki verilerin A'lar alt alta ve tarihe göre, hemen altında B'ler tarihe göre sıralanmış şekilde olsun istiyorum.

 

[Erdinç FIRTINA]

Sayın Yurttaş kodun açıklaması,

Sayın Yurttaş,
Sizi yeterince yordum. Aslında kodların açıklamaları olsa belki oradan hareketle ben yapmak istediğimi yapmaya çalışırım. Excel için çok yeni olduğumu ve iyi olmadığımı biliyorum. Ama hiç değise başaramazsam sizi rahatsız eder yeniden yardım isterim.

Şimdiden teşekkürler!!!

 

[Merhum İdris SERDAR]

Sayın Yurttaş,
Her şey için teşekkürler. Ama göndermiş olduğunuz dosyada da aktar ve topla makrosu çalışmasına rağmen istediğim tarihe göre sıralama olmuyor. Herhalde ben bir hata yapıyorum. Ya da anlatamadım. Yapmak istediğim şu.

Veriler aktarılırken açılan A sayfasında A sütunundaki verilerin küçükten büyüğe doğru tarihe göre, B sayfasında B sütunundaki verilerin küçükten büyüğe doğru tarihe göre sıralanması, topla makrosunda da VERİ2 sayfasındaki verilerin A'lar alt alta ve tarihe göre, hemen altında B'ler tarihe göre sıralanmış şekilde olsun istiyorum.

Dosyayı güncelledim.

Yukarıya bakın.

..

 

[Erdinç FIRTINA]

Sayın Yurttaş çok çok teşekkürler!!!

 

[Erdinç FIRTINA]

Sayın Yurttaş'a çok çok teşekkürler!!!

Sayın Yurttaş,

Size gerçekten çok ama çok teşekkür ederim.

 

[Erdinç FIRTINA]

Satır ve sütun genişletmeye çalışıyorum

Değerli arkadaşlar,
Yukarıdaki dosyanın kodlarında değişiklik yaparak satır ve sütun sayısını değiştirmek istiyorum. Ama olmuyor.

Acaba neyi yanlış yapıyorum. Bir yardım lütfen!

Range("A1:E31").Sort Key1:=Range("B2"), Order1:=xlAscending
Range("A1:E31").Sort Key1:=Range("A2"), Order1:=xlAscending

Bu satırlardaki E31'leri E1000 yapmam gerekmiyor mu?

 

[Merhum İdris SERDAR]

Değerli arkadaşlar,
Yukarıdaki dosyanın kodlarında değişiklik yaparak satır ve sütun sayısını değiştirmek istiyorum. Ama olmuyor.

Acaba neyi yanlış yapıyorum. Bir yardım lütfen!

Range("A1:E31").Sort Key1:=Range("B2"), Order1:=xlAscending
Range("A1:E31").Sort Key1:=Range("A2"), Order1:=xlAscending

Bu satırlardaki E31'leri E1000 yapmam gerekmiyor mu?

Bunları yaparken, Ekle / Ad / Tanımla ile belirlenmiş "Veritabanı" alanını belirleyen =VERİ!$A$1:$E$31 da =VERİ!$A$1:$E$1000 yaparsanız problem olmaz.

Ayrıda aşağıdaki linkte,

http://www.excel.web.tr/showthread.php?t=20271

Bu tür hallerde:


1. VERİTABANI alan tanımlamasında yer alan formülü (=VERİ!$A$1:$E$100) daha geniş bir alanı kapsaması için gerekirse satır ve sütun yönünden genişletmemiz gerekir. (Bunun Insert/Name/Define - Ekle/Ad/Tanımla'dan yapıldığını biliyoruz.)

2. J ve L sütunlarını eklenen verilerle işgal edilmeleri durumunda Kod sayfasındaki kodlarda yer alan bu J ve L sütunlarını ötelememiz gerekir. Örneğin bunları X ve Z yapabiliriz. Veya daha da öteleyebiliriz. Eğer X ve Z yaparsak kodda J ve L geçen yerlere bu kez X ve Z koymamız gerekecek. (Kod sayfasına ulaşmak için ALT+F11 tuşlarına aynı anda basılarak ulaşıldığını biliyoruz.)

3. en üste satır eklediğimizde cretira alanı olarak tanımlanan L1:L2 değişeceğinden; kodda yer alan L1:L2'lerde ona göre uyarlanması gerekir.


şeklinde gerekli açıklamaları da yapmıştım.
..

 

[Erdinç FIRTINA]

Sayın Yurttaş çok çok teşekkür ederim.

Sayın Yurttaş,
Çok çok teşekkür ederim. Verdiğiniz bilgiler sayesinde becerebildim şükür.

Sayın Yurttaş, koddaki aşağıda belirttiğim satırı silerek açık olan sayfalara veri aktarırken sadece tanımladığım alanı silerek verileri aktarmasını, verilerin alanı dışındaki alanı silmemesini istiyorum. Çünkü oralara manuel olarak veri girişi yapmak istiyorum. Böyle bir şey mümkün müdür?
Eğer değilse hiç uğraşmayayım.

If SAYFA(c.Value) Then

SİLMEK İSTEDİĞİM SATIR ---> Sheets(c.Value).Cells.Clear

ALAN.AdvancedFilter Action:=xlFilterCopy, _
CriteriaRange:=Sheets("VERİ").Range("L1:L2"), _
CopyToRange:=Sheets(c.Value).Range("A1"), _
Unique:=False