Macro ile başka dosyadan veri listeleme

[lahanaci]

Merhaba arkadaşlar;

Aşağıda ki kod ile aynı dosyada bulunan "SATIS_DATA" ve "SATIS_SORGU" sayfaları arasında veri listeleme yapabiliyorum. Ancak kopyalama şekli olarak ".PasteSpecial Paste:=xlPasteValues" yerine ".PasteSpecial Paste:=xlPasteAll" kullanmak zorunda olduğum için 650-700 KB olan dosyanın boyutu 4.700 KB'a kadar çıkıyor ve bu benim olmasını istemediğim bir şey.

Burada benim yapmak istediğim şey "SATIS_SORGU" sayfasını bir başka dosyada oluşturup aşağıda ki kodu farklı dosyalar arasında çalışacak şekilde düzenlemek. Örneğin "SATIS_DATA" sayfası "ANA.XLS" içinde olsun, "SATIS_SORGU" sayfasıda "SORGULAMA.XLS" içinde olsun. "SATIS_SORGU" sayfasındaki makroyu çalıştırdığımda "ANA.XLS" içinde ki "SATIS_DATA" sayfasından gerekli verileri listeleyip belirtilen yere (SATIS_SORGU) yapıştırsın.

Eğer "ANA.XLS" kapalı ikende dosya yolu gösterilmeksizin işlem yapılabilirse şahane olur. Ama ANA.XLS kapalı durumdayken illa ki kodda dosya yolu gösterilmesi mecburi ise, ANA.XLS açık olacak şekilde kod yazılabilir.

Kod:

Sub satis_sorgu() ' LİSTELEME YAP
Sheets("SATIS_SORGU").Select
ActiveSheet.Unprotect
Dim sin, liste1, liste2
sin = Range("D4")
If Range("D4") = "" Then
MsgBox "BİLGİLERİNİ GÖRMEK İSTEDİĞİNİZ FİRMANIN KODUNU YAZINIZ."
Range("D4").Select
If sin = Cancel Then
Exit Sub
End If
End If
Sheets("SATIS_DATA").Select
Range("A10:Q10").Select
Selection.AutoFilter
Selection.AutoFilter Field:=1, Criteria1:=sin
Sheets("SATIS_DATA").Select
Rows("10:65000").Select
Selection.Copy
Sheets("SATIS_SORGU").Range("A15").PasteSpecial Paste:=xlPasteAll, Transpose:=False
Application.CutCopyMode = False
Sheets("SATIS_DATA").Select
Selection.AutoFilter

Sheets("SATIS_SORGU").Select
Range(ActiveCell, ActiveCell.End(xlDown)).Select
Range("A1").Select
End Sub


Dosyaları yüklemedim, eğer isterseniz derhal yüklerim.
Yardımlarınızı bekliyorum.

İyi çalışmalar...

 

[Levent Menteşoğlu]

Kendi makronuzu aşağıdaki gibi düzenlerseniz istediğiniz sonucu alabilirsiniz. Ancak iki ayrı dosya kullanmak isterseniz bu durumda kapalı dosyadan veri alma uygulamaları mantığını kullanmanız gerekir. (ADO-DAO gibi)

Sub satis_sorgu() ' LİSTELEME YAP
Sheets("SATIS_SORGU").Unprotect
Dim sin, liste1, liste2
sin = Range("D4")
If Range("D4") = "" Then
MsgBox "BİLGİLERİNİ GÖRMEK İSTEDİĞİNİZ FİRMANIN KODUNU YAZINIZ."
Range("D4").Select
If sin = Cancel Then
Exit Sub
End If
End If
Application.screenupdating = False
Sheets("SATIS_DATA").Range("A10:Q10").AutoFilter
Sheets("SATIS_DATA").Range("A10:Q10").AutoFilter Field:=1, Criteria1:=sin
Sheets("SATIS_DATA").Rows("10:65000").currentregion.Copy
Sheets("SATIS_SORGU").Range("A15").PasteSpecial Paste:=xlPasteValues, Transpose:=False
Sheets("SATIS_DATA").Range("A10:Q10").AutoFilter
End Sub

 

[lahanaci]

Kendi makronuzu aşağıdaki gibi düzenlerseniz istediğiniz sonucu alabilirsiniz. Ancak iki ayrı dosya kullanmak isterseniz bu durumda kapalı dosyadan veri alma uygulamaları mantığını kullanmanız gerekir. (ADO-DAO gibi)

Sub satis_sorgu() ' LİSTELEME YAP
Sheets("SATIS_SORGU").Unprotect
Dim sin, liste1, liste2
sin = Range("D4")
If Range("D4") = "" Then
MsgBox "BİLGİLERİNİ GÖRMEK İSTEDİĞİNİZ FİRMANIN KODUNU YAZINIZ."
Range("D4").Select
If sin = Cancel Then
Exit Sub
End If
End If
Application.screenupdating = False
Sheets("SATIS_DATA").Range("A10:Q10").AutoFilter
Sheets("SATIS_DATA").Range("A10:Q10").AutoFilter Field:=1, Criteria1:=sin
Sheets("SATIS_DATA").Rows("10:65000").currentregion.Copy
Sheets("SATIS_SORGU").Range("A15").PasteSpecial Paste:=xlPasteValues, Transpose:=False
Sheets("SATIS_DATA").Range("A10:Q10").AutoFilter
End Sub

Sayın Levent Menteşoğlu;

Yazdığınız kod harika çalışıyor.
hatta ben pastevalues değerini yine pasteall yaptım ama hiç sıkıntı çıkarmadı.
harika olmuş
ellerinize sağlık.

İlginiz ve yardımınız için teşekkür ediyorum...