Mükerrer topla

[erzen]

Arkadaşlar ekteki dosyada stok kodu aynı olan ürünleri stok sütununa toplam aldırıp daha sonra mükerreri sildirmek için bir kod buldum. Ancak 20000 civarı ürün olunca bilgisayar bir türlü işlemi tamamlayamıyor. Yardımlarınızı bekliyorum.

 

[Muhammet Okumuş]

Merhaba,

Sub mükerrer_topla()
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Sheets(2).Delete
Sheets(1).Select
Sheets("Sayfa1").Copy After:=Sheets(Worksheets.Count)
ActiveSheet.Name = "STOK"
ActiveSheet.DrawingObjects.Delete
Columns(1).EntireColumn.Insert
Range("B1", Range("B65536").End(xlUp)).AdvancedFilter _
Action:=xlFilterCopy, CopyToRange:=Range("A1"), Unique:=True
Columns(2).EntireColumn.Delete
Range("B" & Range("A65536").End(3).Row & ":Z65536") = ""
Range("P2" & Range("P65536").End(3).Row) = "=SUMIF(Sayfa1!A$2:A$20000,A2,Sayfa1!P$2$20000)"
Range("P2" & Range("P65536").End(3).Row) = Range("P2" & Range("P65536").End(3).Row).Value
Range("a1").Select
End Sub

deneyiniz.

 

[erzen]

Kod hata veriyor işlemide yapmıyor

 

[Muhammet Okumuş]

Hatalı dosyayı eklermisiniz

 

[Muhammet Okumuş]

Kusura bakmayın. Dosyanız üzerinde değişiklik yapmıştım.Eklemiş olduğum dosyada deneyiniz.