• DİKKAT

    DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
    Altın Üyelik Hakkında Bilgi

C:\AORT.XLS adlı kitabımdaki "fl" adlı tablom'd

Katılım
24 Ağustos 2004
Mesajlar
140
Excel Vers. ve Dili
Excel Vers. ve Dili Ofis 2021 TR 32 Bit
Merhaba,

Fiyat teklifi sunduğum tablom(MASTER.XLS)

(sütunlar Ürün adı(A sütunu, arama bu sütunda yapılacak), Stok durumu(b sütunu), Fiyatı(c sütunu) ve Döviz türü(d sütunu) olarak kayıtlıdır.)

Bu kayıtlardan (a sütununda arama yapıp) "CDRW" ve "CDR" ile başlayan kayıtları kopyalayıp Master.xls adlı kitabımın "CD" tablosuna nasıl yapıştırabilirim?

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

Umut Sancar
 
Ã?rnek dosyam ekte...

Ã?rnek dosyam ekte. Yardımlarınız için şimdiden teşekkür ederim.
 
Arkadaşlar, yanıt verecek kimse yok mu :)
 
Aşağıdaki kodu deneyin. Kodun doğru çalışması için AORT isimli dosyanızdaki verileri 2.satırdan başlatın ve 1.satıra başlık metinleri yazın.

[vb:1:0dc25fa623]Sub kopyala()
Application.ScreenUpdating = False
Workbooks.Open Filename:="C:\AORT.xls"
[a1:d1].AutoFilter
[a1:d1].AutoFilter Field:=1, Criteria1:="=*CD-R*"
[a1:d65536].Copy
Workbooks("MASTER.xls").Activate
Sheets("CD").Select
[a1].Select
ActiveSheet.Paste
Columns("A: D").EntireColumn.AutoFit
Workbooks("AORT.xls").Activate
[a1:d1].AutoFilter
Workbooks("AORT.xls").Save
Workbooks("AORT.xls").Close
[e1].Select
End Sub
[/vb:1:0dc25fa623]
 
LeventM, çok teşekkür ederim. Az kaldı, tablom istediğim şekle girecek.

Bu makroda birden fazla kriteri nasıl kullanabilirim? Ã?rneğin "=*CD-R*" ile birlikte "=DVD*" yi nasıl "CD" tablosuna aktarabilirim?
 
Aşağıdaki gibi deneyin.


[vb:1:109e00adc5][a1:d1].AutoFilter Field:=1, Criteria1:="=*CD-R*", Criteria2:="=*DVD*"[/vb:1:109e00adc5]
 
Alt alta bu makroyu değişik parametreler ile kullandım ve sonlara doğru bu hatayı verdi. Nasıl çözebilirim? Pano ile mi alakalı acaba?

"Excel kullanılabilir kaynaklar ile bu görevi tamamlayamıyor. Daha az veri seçin veya diğer uygulamaları kapatın"
 
maalesef ikiden fazla kriter belirleyemezsiniz.
 
Yok, 2'den fazla kriter belirlemedim.

Makro gayet sağlıklı. Aynı makroyu değişik parametrelerle kullandım derken; örneğin MON ile başlayanları "MON" adlı tabloya, FLO* ile başlayanları "FDD" adlı tabloya kopyalıyor...

Hatam nedir?

kodlar aşağıda:

Sub GUNCELLE()
Application.ScreenUpdating = False
Workbooks.Open Filename:="C:\AORT.xls"
[a1:d1].AutoFilter
[a1:d1].AutoFilter Field:=1, Criteria1:="=CD*", Criteria2:="=DVD*"
[a1:d65536].Copy
Workbooks("METROPOL.xls").Activate
Sheets("CD").Select
[a1].Select
ActiveSheet.Paste
Columns("A").EntireColumn.AutoFit
Workbooks("AORT.xls").Activate
[a1:d1].AutoFilter
Workbooks("AORT.xls").Save
Workbooks("AORT.xls").Close
[e1].Select
Application.ScreenUpdating = False
Workbooks.Open Filename:="C:\AORT.xls"
[a1:d1].AutoFilter
[a1:d1].AutoFilter Field:=1, Criteria1:="=CPU*"
[a1:d65536].Copy
Workbooks("METROPOL.xls").Activate
Sheets("CPU").Select
[a1].Select
ActiveSheet.Paste
Columns("A").EntireColumn.AutoFit
Workbooks("AORT.xls").Activate
[a1:d1].AutoFilter
Workbooks("AORT.xls").Save
Workbooks("AORT.xls").Close
[e1].Select
Application.ScreenUpdating = False
Workbooks.Open Filename:="C:\AORT.xls"
[a1:d1].AutoFilter
[a1:d1].AutoFilter Field:=1, Criteria1:="=MB *"
[a1:d65536].Copy
Workbooks("METROPOL.xls").Activate
Sheets("ANAKART").Select
[a1].Select
ActiveSheet.Paste
Columns("A").EntireColumn.AutoFit
Workbooks("AORT.xls").Activate
[a1:d1].AutoFilter
Workbooks("AORT.xls").Save
Workbooks("AORT.xls").Close
[e1].Select
Application.ScreenUpdating = False
Workbooks.Open Filename:="C:\AORT.xls"
[a1:d1].AutoFilter
[a1:d1].AutoFilter Field:=1, Criteria1:="=VGA*"
[a1:d65536].Copy
Workbooks("METROPOL.xls").Activate
Sheets("VGA").Select
[a1].Select
ActiveSheet.Paste
Columns("A").EntireColumn.AutoFit
Workbooks("AORT.xls").Activate
[a1:d1].AutoFilter
Workbooks("AORT.xls").Save
Workbooks("AORT.xls").Close
[e1].Select
Application.ScreenUpdating = False
Workbooks.Open Filename:="C:\AORT.xls"
[a1:d1].AutoFilter
[a1:d1].AutoFilter Field:=1, Criteria1:="=MODEM*"
[a1:d65536].Copy
Workbooks("METROPOL.xls").Activate
Sheets("MODEM").Select
[a1].Select
ActiveSheet.Paste
Columns("A").EntireColumn.AutoFit
Workbooks("AORT.xls").Activate
[a1:d1].AutoFilter
Workbooks("AORT.xls").Save
Workbooks("AORT.xls").Close
[e1].Select
Application.ScreenUpdating = False
Workbooks.Open Filename:="C:\AORT.xls"
[a1:d1].AutoFilter
[a1:d1].AutoFilter Field:=1, Criteria1:="=FLO*"
[a1:d65536].Copy
Workbooks("METROPOL.xls").Activate
Sheets("FDD").Select
[a1].Select
ActiveSheet.Paste
Columns("A").EntireColumn.AutoFit
Workbooks("AORT.xls").Activate
[a1:d1].AutoFilter
Workbooks("AORT.xls").Save
Workbooks("AORT.xls").Close
[e1].Select
Application.ScreenUpdating = False
Workbooks.Open Filename:="C:\AORT.xls"
[a1:d1].AutoFilter
[a1:d1].AutoFilter Field:=1, Criteria1:="=SPK*"
[a1:d65536].Copy
Workbooks("METROPOL.xls").Activate
Sheets("SPK").Select
[a1].Select
ActiveSheet.Paste
Columns("A").EntireColumn.AutoFit
Workbooks("AORT.xls").Activate
[a1:d1].AutoFilter
Workbooks("AORT.xls").Save
Workbooks("AORT.xls").Close
[e1].Select
Application.ScreenUpdating = False
Workbooks.Open Filename:="C:\AORT.xls"
[a1:d1].AutoFilter
[a1:d1].AutoFilter Field:=1, Criteria1:="=HD*"
[a1:d65536].Copy
Workbooks("METROPOL.xls").Activate
Sheets("HDD").Select
[a1].Select
ActiveSheet.Paste
Columns("A").EntireColumn.AutoFit
Workbooks("AORT.xls").Activate
[a1:d1].AutoFilter
Workbooks("AORT.xls").Save
Workbooks("AORT.xls").Close
[e1].Select
Application.ScreenUpdating = False
Workbooks.Open Filename:="C:\AORT.xls"
[a1:d1].AutoFilter
[a1:d1].AutoFilter Field:=1, Criteria1:="=CASE*"
[a1:d65536].Copy
Workbooks("METROPOL.xls").Activate
Sheets("KASA").Select
[a1].Select
ActiveSheet.Paste
Columns("A").EntireColumn.AutoFit
Workbooks("AORT.xls").Activate
[a1:d1].AutoFilter
Workbooks("AORT.xls").Save
Workbooks("AORT.xls").Close
[e1].Select
Application.ScreenUpdating = False
Workbooks.Open Filename:="C:\AORT.xls"
[a1:d1].AutoFilter
[a1:d1].AutoFilter Field:=1, Criteria1:="=PR*"
[a1:d65536].Copy
Workbooks("METROPOL.xls").Activate
Sheets("PRIN").Select
[a1].Select
ActiveSheet.Paste
Columns("A").EntireColumn.AutoFit
Workbooks("AORT.xls").Activate
[a1:d1].AutoFilter
Workbooks("AORT.xls").Save
Workbooks("AORT.xls").Close
[e1].Select
Application.ScreenUpdating = False
Workbooks.Open Filename:="C:\AORT.xls"
[a1:d1].AutoFilter
[a1:d1].AutoFilter Field:=1, Criteria1:="=SCAN*"
[a1:d65536].Copy
Workbooks("METROPOL.xls").Activate
Sheets("SCAN").Select
[a1].Select
ActiveSheet.Paste
Columns("A").EntireColumn.AutoFit
Workbooks("AORT.xls").Activate
[a1:d1].AutoFilter
Workbooks("AORT.xls").Save
Workbooks("AORT.xls").Close
[e1].Select
Application.ScreenUpdating = False
Workbooks.Open Filename:="C:\AORT.xls"
[a1:d1].AutoFilter
[a1:d1].AutoFilter Field:=1, Criteria1:="=RAM*"
[a1:d65536].Copy
Workbooks("METROPOL.xls").Activate
Sheets("RAM").Select
[a1].Select
ActiveSheet.Paste
Columns("A").EntireColumn.AutoFit
Workbooks("AORT.xls").Activate
[a1:d1].AutoFilter
Workbooks("AORT.xls").Save
Workbooks("AORT.xls").Close
[e1].Select
Application.ScreenUpdating = False
Workbooks.Open Filename:="C:\AORT.xls"
[a1:d1].AutoFilter
[a1:d1].AutoFilter Field:=1, Criteria1:="=UPS*"
[a1:d65536].Copy
Workbooks("METROPOL.xls").Activate
Sheets("UPS").Select
[a1].Select
ActiveSheet.Paste
Columns("A").EntireColumn.AutoFit
Workbooks("AORT.xls").Activate
[a1:d1].AutoFilter
Workbooks("AORT.xls").Save
Workbooks("AORT.xls").Close
[e1].Select
Application.ScreenUpdating = False
Workbooks.Open Filename:="C:\AORT.xls"
[a1:d1].AutoFilter
[a1:d1].AutoFilter Field:=1, Criteria1:="=MON *", Criteria2:="=LCD *"
[a1:d65536].Copy
Workbooks("METROPOL.xls").Activate
Sheets("MON").Select
[a1].Select
ActiveSheet.Paste
Columns("A").EntireColumn.AutoFit
Workbooks("AORT.xls").Activate
[a1:d1].AutoFilter
Workbooks("AORT.xls").Save
Workbooks("AORT.xls").Close
[e1].Select
Application.ScreenUpdating = False
Workbooks.Open Filename:="C:\AORT.xls"
[a1:d1].AutoFilter
[a1:d1].AutoFilter Field:=1, Criteria1:="=KB*"
[a1:d65536].Copy
Workbooks("METROPOL.xls").Activate
Sheets("KEY").Select
[a1].Select
ActiveSheet.Paste
Columns("A").EntireColumn.AutoFit
Workbooks("AORT.xls").Activate
[a1:d1].AutoFilter
Workbooks("AORT.xls").Save
Workbooks("AORT.xls").Close
[e1].Select
Application.ScreenUpdating = False
Workbooks.Open Filename:="C:\AORT.xls"
[a1:d1].AutoFilter
[a1:d1].AutoFilter Field:=1, Criteria1:="=MOUSE*"
[a1:d65536].Copy
Workbooks("METROPOL.xls").Activate
Sheets("FARE").Select
[a1].Select
ActiveSheet.Paste
Columns("A").EntireColumn.AutoFit
Workbooks("AORT.xls").Activate
[a1:d1].AutoFilter
Workbooks("AORT.xls").Save
Workbooks("AORT.xls").Close
[e1].Select
Application.ScreenUpdating = False
Workbooks.Open Filename:="C:\AORT.xls"
[a1:d1].AutoFilter
[a1:d1].AutoFilter Field:=1, Criteria1:="=TV*"
[a1:d65536].Copy
Workbooks("METROPOL.xls").Activate
Sheets("TV K").Select
[a1].Select
ActiveSheet.Paste
Columns("A").EntireColumn.AutoFit
Workbooks("AORT.xls").Activate
[a1:d1].AutoFilter
Workbooks("AORT.xls").Save
Workbooks("AORT.xls").Close
[e1].Select
End Sub
 
Kriterleri çift yıldız içine neden alarak deneyin. "=MOUSE*" yerine "=*MOUSE*" gibi
 
Sevgili LeventM,

Sorunum kriterler değil. İki kriter kullandığımda sonuç alamıyorum ama benim için 1. derecede önemli olan: sizin verdiğiniz makro yu yukarıdaki gibi düzenlediğim zaman sonlara doğru hata veriyor olması. Bunun makrodan kaynaklandığını düşünmüyorum. Ancak yine de sorunu algılayamadım. Hata nereden kaynaklanıyor?

Teşekkür ederim.
 
Aşağıdaki kodu deneyin. Üzerinde biraz daha çalışarak kod çok daha fazla kısaltılabilir.

[vb:1:7191940789]Sub kopyala()
On Error Resume Next
Application.ScreenUpdating = False

Workbooks.Open Filename:="C:\AORT.xls"
[a1:d1].AutoFilter
[a1:d1].AutoFilter Field:=1, Criteria1:="=CD*", Operator:=xlOr, Criteria2:="=DVD*"
[a1:d65536].Copy
Workbooks("METROPOL.xls").Activate
Sheets("CD").Select
[a1].Select
ActiveSheet.Paste
Columns("A").EntireColumn.AutoFit

Workbooks("AORT.xls").Activate
[a1:d1].AutoFilter Field:=1, Criteria1:="=CPU*"
[a1:d65536].Copy
Workbooks("METROPOL.xls").Activate
Sheets("CPU").Select
[a1].Select
ActiveSheet.Paste
Columns("A").EntireColumn.AutoFit

Workbooks("AORT.xls").Activate
[a1:d1].AutoFilter Field:=1, Criteria1:="=MB *"
[a1:d65536].Copy
Workbooks("METROPOL.xls").Activate
Sheets("ANAKART").Select
[a1].Select
ActiveSheet.Paste
Columns("A").EntireColumn.AutoFit

Workbooks("AORT.xls").Activate
[a1:d1].AutoFilter Field:=1, Criteria1:="=VGA*"
[a1:d65536].Copy
Workbooks("METROPOL.xls").Activate
Sheets("VGA").Select
[a1].Select
ActiveSheet.Paste
Columns("A").EntireColumn.AutoFit

Workbooks("AORT.xls").Activate
[a1:d1].AutoFilter Field:=1, Criteria1:="=MODEM*"
[a1:d65536].Copy
Workbooks("METROPOL.xls").Activate
Sheets("MODEM").Select
[a1].Select
ActiveSheet.Paste
Columns("A").EntireColumn.AutoFit

Workbooks("AORT.xls").Activate
[a1:d1].AutoFilter Field:=1, Criteria1:="=FLO*"
[a1:d65536].Copy
Workbooks("METROPOL.xls").Activate
Sheets("FDD").Select
[a1].Select
ActiveSheet.Paste
Columns("A").EntireColumn.AutoFit

Workbooks("AORT.xls").Activate
[a1:d1].AutoFilter Field:=1, Criteria1:="=SPK*"
[a1:d65536].Copy
Workbooks("METROPOL.xls").Activate
Sheets("SPK").Select
[a1].Select
ActiveSheet.Paste
Columns("A").EntireColumn.AutoFit

Workbooks("AORT.xls").Activate
[a1:d1].AutoFilter Field:=1, Criteria1:="=HD*"
[a1:d65536].Copy
Workbooks("METROPOL.xls").Activate
Sheets("HDD").Select
[a1].Select
ActiveSheet.Paste
Columns("A").EntireColumn.AutoFit

Workbooks("AORT.xls").Activate
[a1:d1].AutoFilter Field:=1, Criteria1:="=CASE*"
[a1:d65536].Copy
Workbooks("METROPOL.xls").Activate
Sheets("KASA").Select
[a1].Select
ActiveSheet.Paste
Columns("A").EntireColumn.AutoFit

Workbooks("AORT.xls").Activate
[a1:d1].AutoFilter Field:=1, Criteria1:="=PR*"
[a1:d65536].Copy
Workbooks("METROPOL.xls").Activate
Sheets("PRIN").Select
[a1].Select
ActiveSheet.Paste
Columns("A").EntireColumn.AutoFit

Workbooks("AORT.xls").Activate
[a1:d1].AutoFilter Field:=1, Criteria1:="=SCAN*"
[a1:d65536].Copy
Workbooks("METROPOL.xls").Activate
Sheets("SCAN").Select
[a1].Select
ActiveSheet.Paste
Columns("A").EntireColumn.AutoFit

Workbooks("AORT.xls").Activate
[a1:d1].AutoFilter Field:=1, Criteria1:="=RAM*"
[a1:d65536].Copy
Workbooks("METROPOL.xls").Activate
Sheets("RAM").Select
[a1].Select
ActiveSheet.Paste
Columns("A").EntireColumn.AutoFit

Workbooks("AORT.xls").Activate
[a1:d1].AutoFilter Field:=1, Criteria1:="=UPS*"
[a1:d65536].Copy
Workbooks("METROPOL.xls").Activate
Sheets("UPS").Select
[a1].Select
ActiveSheet.Paste
Columns("A").EntireColumn.AutoFit

Workbooks("AORT.xls").Activate
[a1:d1].AutoFilter Field:=1, Criteria1:="=MON *", Criteria2:="=LCD *"
[a1:d65536].Copy
Workbooks("METROPOL.xls").Activate
Sheets("MON").Select
[a1].Select
ActiveSheet.Paste
Columns("A").EntireColumn.AutoFit

Workbooks("AORT.xls").Activate
[a1:d1].AutoFilter Field:=1, Criteria1:="=KB*"
[a1:d65536].Copy
Workbooks("METROPOL.xls").Activate
Sheets("KEY").Select
[a1].Select
ActiveSheet.Paste
Columns("A").EntireColumn.AutoFit

Workbooks("AORT.xls").Activate
[a1:d1].AutoFilter Field:=1, Criteria1:="=MOUSE*"
[a1:d65536].Copy
Workbooks("METROPOL.xls").Activate
Sheets("FARE").Select
[a1].Select
ActiveSheet.Paste
Columns("A").EntireColumn.AutoFit

Workbooks("AORT.xls").Activate
[a1:d1].AutoFilter Field:=1, Criteria1:="=TV*"
[a1:d65536].Copy
Workbooks("METROPOL.xls").Activate
Sheets("TV K").Select
[a1].Select
ActiveSheet.Paste
Columns("A").EntireColumn.AutoFit
Workbooks("AORT.xls").Activate
[a1:d1].AutoFilter
Workbooks("AORT.xls").Save
Workbooks("AORT.xls").Close
[e1].Select
End Sub
[/vb:1:7191940789]
 
Teşekkürler LeventM,

Bir sorunum var, 1,5Mb'lık dosyam bu güncellemeyi yaptıktan sonra 40Mb'a kadar yükseldi. Ne yapmalıyım?
 
Bu durumda veri sayısından daha çok biçimlendirmeler devreye girer. kod içindeki tüm; "ActiveSheet.Paste" satırlarını aşağıdaki gibi değiştirerek deneyin.


ActiveSheet.PasteSpecial Paste:=xlPasteValues
 
Ataça dosyaları ekledim...

Sevgili LeventM,

Ataça dosyaları ekledim. Gözden geçirmeniz iyi olacak kanaatindeyim.

Ben sadece değerleri yapıştırması için gereken kodları değiştirdim ama hala sorun yaşıyorum.
 
Aşağıdaki kodu metropol dosyasında çalıştırarak hacminin ne kadar düştüğünü inceleyin.

Not:kodu dosyanızın bir kopyasında çalıştırarak deneyin.

[vb:1:6a7b604bf2]Sub sil()
For a = 1 To Sheets.Count
Sheets(a).[e:iv].Delete
Sheets(a).[a:iv].EntireColumn.AutoFit
sonsat = Sheets(a).[a65536].End(3).Row + 1
Sheets(a).Rows(sonsat & ":65536").Delete
Next
End Sub

[/vb:1:6a7b604bf2]
 
Geri
Üst