Soru Dosya yolunu göstererek içerisindeki sekmeyi açık çalışma kitabına kopyalama

[xternet]

Merhaba arkadaşlar.

Bilgisayardaki herhangi bir excel dosyasına ulaşıp içerisindeki "Sheet1" sekmesini kitabımın içerisine kopyalamak istiyorum. Dosya içerisinde sadece Sheet1 sekmesi var.
Yani kodu çalıştırdığımda dosyanın yolunu şeçmemi sağlayacak ekran açılacak. Dosya yolunu seçince içerisinden Sheet1 sayfasının kopyasını açık kitabımın içerisine alacak.

Böyle bir kod yazmanın mümkünatı var ise yardımcı olacak arkadaşlara şimdiden çok teşekkür ederim.

Herkese iyi çalışmalar, hayırlı pazarlar...

 

[xternet]

Bir yolu var mı acaba arkadaşlar.

 

[Korhan Ayhan]

Sayfayı taşı-kopyala şeklindemi aktif dosyanıza aktaracak yoksa içindeki veriler mi aktarılacak?

 

[Korhan Ayhan]

Burada sorunuza benzer bir konu buldum. Kodları sanırım kendinize uyarlarsınız.

Gözat penceresi ile sayfa kopyalama.

Gözat penceresinden adında GunlukGorevListesi geçen xls dosyasını seçmek ve seçtiğim kitap içerisindeki GorevListesi sayfasının tümünü ya da A2:Q aralığını kopyalayarak GunlukGorevListesi dosyası GorevListesi sayfasına almak istiyorum. Epey uğraştım yapamadım yardımlarınızı rica ediyorum.

www.excel.web.tr

 

[xternet]

Sayfayı taşı-kopyala şeklindemi aktif dosyanıza aktaracak yoksa içindeki veriler mi aktarılacak?

Sayfayı taşı-kopyala şeklinde Sayın Korhan Ayhan.
Gönderdiğiniz linki de ki koddan anladığım kadarıyla o kod sayfadaki verileri kopyalıyor sanırım.

 

[Korhan Ayhan]

Deneyiniz.

Option Explicit

Sub Sheets_Copy()
    Dim My_File As Variant, My_Sheet As Worksheet
  
    My_File = Application.GetOpenFilename(FileFilter:="Excel Dosyası, *.xls; *.xlsx; *.xlsm", MultiSelect:=False)
   
    If My_File = Empty Then
        MsgBox "Lütfen önce dosya seçiniz!", vbExclamation
        Exit Sub
    End If
   
    On Error Resume Next
    Set My_File = Workbooks.Open(My_File)
    Set My_Sheet = Nothing
    Set My_Sheet = Workbooks(My_File.Name).Worksheets("Sheet1")
    On Error GoTo 0
   
    If Not My_Sheet Is Nothing Then
        My_Sheet.Copy After:=ThisWorkbook.Worksheets(ThisWorkbook.Worksheets.Count)
        My_File.Close 0
        MsgBox "Sayfa kopyalanmıştır.", vbInformation
    Else
        My_File.Close 0
        MsgBox "Sayfa bulunamadı!", vbCritical
    End If

    Set My_File = Nothing
End Sub

 

[xternet]

Sayın Korhan Ayhan,
Kod ilgili dosyayı seçtirdikten sonra bir an için kitabı açıyor. Sheet1 sayfasını bir an için görüyorum ama sayfayı kopyalamadan sayfa bulunamadı mesajı ile bitiyor.

(Excel 2010 ile çalışıyorum.)

 

[Korhan Ayhan]

Önerdiğim kodu tekrar deneyiniz.

 

[xternet]

Önerdiğim kodu tekrar deneyiniz.

Bu sefer tamam Sayın Korhan Ayhan.
Çok teşekkür ediyorum.
Elinize, zihninize sağlık.

 

[xternet]

Merhaba arkadaşlar,
İlave sorumu sormadan önce konuyu kısaca hatırlatacak olursam:
kapalı duran bir çalışma kitabından başka bir çalışma kitabına sheet1 sayfasını kopyala ile ilgiliydi.
Kod son şekli ile çok güzel işliyor.

Dim My_File As Variant, My_Sheet As Worksheet
My_File = Application.GetOpenFilename(FileFilter:="Excel Dosyası, *.xls; *.xlsx; *.xlsm", MultiSelect:=False)
If My_File = Empty Then
MsgBox "Lütfen önce dosya seçiniz!", vbExclamation
Exit Sub
End If

On Error Resume Next
Set My_File = Workbooks.Open(My_File)
Set My_Sheet = Nothing
Set My_Sheet = Workbooks(My_File.Name).Worksheets("Sheet1")
On Error GoTo 0

If Not My_Sheet Is Nothing Then
My_Sheet.Copy After:=ThisWorkbook.Worksheets(ThisWorkbook.Worksheets.Count)
My_File.Close 0
MsgBox "Sayfa kopyalanmıştır.", vbInformation
Else
My_File.Close 0
MsgBox "Dosya içerisinde Sheet1 bulunamadı! Dosyayı kontrol ediniz.?", vbCritical
GoTo Pasgec
End If
Application.DisplayAlerts = True
Set My_File = Nothing


İlave olarak, eğer sayfa sekmesini kopyalamak istediğimiz çalışma kitabı korumalı ise,
bu koruma şifresini bu programa nasıl ekleriz.
Yani kodun içerisinde sekmesini kopyalamaya çalıştığımız çalışma kitabının şifresini de yazacağız ve
kopyala işlemi şifreye takılmadan sonuçlanacak.
İlgilenecek arkadaşlara şimdiden çok teşekkür ederim.
İyi çalışmalar.

 

[Korhan Ayhan]

Şu satırı;

Set My_File = Workbooks.Open(My_File)

Bununla değiştirip deneyiniz.

Set My_File = Workbooks.Open(Filename:= My_File, Password:="Dosya Şifresini Buraya Yazınız")

 

[xternet]

Çok teşekkürler Sayın Korhan Ayhan. Her zaman ki gibi nokta atışı . Elinize, zihninize sağlık.