Makroda düzenleme;

[abbasonline]

Sub AKTAR()
Application.ScreenUpdating = False
Sheets("GENEL").Range("a2:F65536").ClearContents
For X = 2 To Worksheets.Count
Sheets(X).Select
Sheets(X).Range("a2:d" & Sheets(X).Range("a65536").End(xlUp).Row).Copy
Sheets(X).Range("E1").Select
Sheets("GENEL").Select
Sheets("GENEL").Range("E65536").End(xlUp).Select
If ActiveCell.Address = "$E$1" Then
ActiveCell.Select
Else
ActiveCell.Offset(1, 0).Select
End If
ActiveSheet.Paste
Application.CutCopyMode = False
Next
Range("a2:F" & [a65536].End(3).Row).RemoveDuplicates Columns:=2, Header:=xlNo
Sheets("GENEL").Range("A1").Select
Application.ScreenUpdating = True
MsgBox "AKTARMA TAMAMLANDI...", vbInformation
End Sub



Bir excel kitabcığında 2009,2010,2011 diye sayfalar mevcut ve bu sayfaların E6 E35000 inci hücrelerinde veriler mevcut ve bu veriler arasında farklı olanları (GENEL) sayfasına makro yardımı ile aktarmak istiyorum ve aktarırken verinin bulunduğu satırdaki A ile H sütunu arasındaki veriler ile birlikte aktarmasını istiyorum. makroda nasıl bir düzenleme yapmam gerekli.

veyahut nasıl bir makro yazmam lazım.

 

[abbasonline]

Makroda düzenleme yapmasakta, sıfırdan makro yazsak daha uygun olacak gibi,

 

[Korhan Ayhan]

Selamlar,

Farklı olanlardan kastınız nedir?

Sadece E sütununa göremi farklı olanları tek sayfada toplamak istiyor sunuz?

 

[AS3434]

Sayın abbasonline

Şöyle birşey mi istiyorsunuz?

Sub AKTAR()
Application.ScreenUpdating = False
Sheets("GENEL").Range("a2:h65536").ClearContents
For X = 2 To Worksheets.Count
Sheets(X).Select
Sheets(X).Range("a2:h" & Sheets(X).[a65536].End(xlUp).Row).Copy
Sheets(X).Range("a1").Select
Sheets("GENEL").Select
Sheets("GENEL").Range("a65536").End(xlUp).Select
ActiveCell.Offset(1, 0).Select
ActiveSheet.Paste
Next
Range("a2:h" & [a65536].End(3).Row).RemoveDuplicates Columns:=[COLOR=red]5[/COLOR], Header:=xlNo
Sheets("GENEL").[A1].Select
Application.ScreenUpdating = True
MsgBox "AKTARMA TAMAMLANDI...", vbInformation
End Sub

Tüm sayfaların A:H aralığını GENEL sayfasına aktarıp, E sütununa göre (Kırmızı) benzersiz olarak listeler.

NOT... Sorunuzda ki püf noktasını atlamışım..Office 2003 kullanıyorsunuz ,ve her sayfanızda 35.000 satır cıvarında veri varsa bu kodlarla olmaz. Sayfalarda süzüp aktarmak gerekli...
Ancak, sayfalarda süzülen de toplamda 65536 satırı geçerse sizinde Office 2007 ye geçme zamanınız gelmiş demektir..

 

[abbasonline]

Korhan bey, Sadece E sütununa göre farklı olanları tek sayfada (GENEL) toplamak istiyorum A ile H aralıkları ile birlikte, ayrıca kitapcıkta sayfa fazla var sadece sayfaların ismi (2009),(2010),(2011) olanlarda E sütununda farklı olanları A ile H aralığı ile birlikte (GENEL) sayfasına yapıştıracak,


(2009),(2010),(2011) sayfalarında E sütununda bulunan veriler E7 den başlıyor, (GENEL sayfasının ikinci satırından itibaren yapıştırmaya başlayabilir.


Office 2010 kullanıyorum.

 

[Korhan Ayhan]

Selamlar,

Bu durumda mesajlarınızda 2010 versiyonu kullandığınızı belirtmelisiniz ve ayrıca imzanızada bu bilgiyi eklemelisiniz. Çünkü size yardımcı olmak isteyen kişiler imzanızdaki bilgiye ya da mesajınızdaki bilgiye göre hareket etmektedirler.

Sn. AS3434 beyin verdiği yanıt bu durumda size hitap ediyor. Çünkü içinde yerleşik işlev olan "Yinelenenleri Kaldır" özelliği kullanılmıştır. Bu komutta diğer kodlara göre oldukça hızlı sonuç vermektedir.

 

[AS3434]

Sayın abbasonline

Profilinizde Office 2003 yazıyor!!!

Kodları şöyle düzenleyin.

Denemeden önce dosyanızın yedeğini alın..

Sub AKTAR()
Application.ScreenUpdating = False
Sheets("GENEL").Range("a2:h1048576").ClearContents
For X = 2 To Worksheets.Count
Sheets(X).Select
If ActiveSheet.Name = "2009" Or ActiveSheet.Name = "2010" Or ActiveSheet.Name = "2011" Then
Sheets(X).Range("a7:h" & [a1048576].End(xlUp).Row).Copy
Sheets(X).Range("a1").Select
Sheets("GENEL").Select
Sheets("GENEL").Range("a1048576").End(xlUp).Select
ActiveCell.Offset(1, 0).Select
ActiveSheet.Paste
End If
Next
Sheets("GENEL").Select
Range("a2:h" & [a1048576].End(3).Row).RemoveDuplicates Columns:=5, Header:=xlNo
Sheets("GENEL").[A1].Select
Application.ScreenUpdating = True
MsgBox "AKTARMA TAMAMLANDI...", vbInformation
End Sub

 

[abbasonline]

Sayın AS3434 Teşekkürler, Korhan bey ilgilendiğiniz için size de teşekkürler, kod çalıştı kolay gelsin.