Tek Tuşla Veri Aktarma

[yorum.halil]

Arkadaşar sitede bir çok örnek var ama ben uyarlayamadım. Ekteki VERI DOSYASINA bir tuş ekleyip tıklayınca MIZAN Dosyasındaki veriler tamamen oraya aktarılacak. Şimdiden Tşk.

 

[yorum.halil]

Arkadaşlar yokmu yardım edecek bir üstad.. Neyse biraz daha bekleyim.

 

[yorum.halil]

Arkadaşlar bu forumda o kadar çok zor soruların cevabını verdiniz sayısını ben bile unuttum. Ama böyle basit bir soru için bu kadar bekleyeceğimi hiç sanmamıştır. Siz sanmayin ki forumda sorduğum soruyu hiç araştırmadan aramadan direk buraya yazdım. Emin olun en az 10-15 örneği inceledim. Çözümü kendi soruma uyarlayamadığım için size sordum. Neyse canınız sağolsun...

 

[yorum.halil]

Hala cevap için beklemedeyim

 

[Korhan Ayhan]

Selamlar,

Ekteki örnek klasörü siteminizde uygun bir yere yerleştirdikten sonra VERI.xls dosyasındaki kodu çalıştırınız.

Option Explicit
 
Sub VERİLERİ_AKTAR()
    Dim Dosya_Yolu As String, Asıl_Dosya As Workbook, Kaynak_Dosya As Workbook
    Application.ScreenUpdating = False
    Set Asıl_Dosya = ThisWorkbook
    Asıl_Dosya.ActiveSheet.[A:F].ClearContents
    Dosya_Yolu = ThisWorkbook.Path & "\"
    Set Kaynak_Dosya = Workbooks.Open(Dosya_Yolu & "MIZAN.xls", False, False)
    Kaynak_Dosya.ActiveSheet.Cells.Copy
    Asıl_Dosya.Activate
    Range("A1").Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
    Range("A1").Select
    Kaynak_Dosya.Close True
    Set Kaynak_Dosya = Nothing
    Set Asıl_Dosya = Nothing
    Application.ScreenUpdating = True
    MsgBox "İşleminiz tamamlanmıştır.", vbInformation
End Sub

 

[yorum.halil]

Sabreden derviş muradına ermiş.. Üstad eline sağlık....

 

[yorum.halil]

Üstadlar bu konu ile ilgili bir sorum daha olacak müsaadenizle. Üstadımızın verdiği kodları kendime göre ayarladım. Aşağıdaki kod istenen dosya olduğu zaman yazi MIZAN.xls dosyası olduğu zaman gayet güzel bir şekilde çalışıyor. Fakat şöyle bir sorun var. MIZAN.xls isimli dosya her zaman kayıtlı olmuyor. Acaba istenen dosya olmadığı zaman yani dosya yoksa "AKTARIM YAPILMADI" diye bir uyarı verilmesi sağlanabilirmi. Şimdiden tşk.

Sub MIZANAKTAR()
Sheets("MIZAN").Select
ActiveSheet.Unprotect "123"
Dim Dosya_Yolu As String, Asıl_Dosya As Workbook, Kaynak_Dosya As Workbook
Application.ScreenUpdating = False
Set Asıl_Dosya = ThisWorkbook
Asıl_Dosya.ActiveSheet.[A:F].ClearContents
Dosya_Yolu = ThisWorkbook.Path & "\"
Set Kaynak_Dosya = Workbooks.Open("D:\ETA7\\MIZAN.xls", False, False)
Kaynak_Dosya.ActiveSheet.Cells.Copy
Asıl_Dosya.Activate
Sheets("MIZAN").Select
Range("A1").Select
ActiveSheet.Paste
Application.CutCopyMode = False
Range("A1").Select
Kaynak_Dosya.Close True
Set Kaynak_Dosya = Nothing
Set Asıl_Dosya = Nothing
Application.ScreenUpdating = True
'MsgBox "İşleminiz tamamlanmıştır.", vbInformation
ActiveSheet.Protect "123"
Sheets("REHBER").Select
End Sub

 

[nazifdural]

Sn.Üstadım,
peki Mizan.xls dosyasının içinde Data isimli sayfayı bu şekilde nasıl aktarabilirdik.kodlarda nasıl bir değişiklik olması lazım.