Soru İçeri/Dışarı Tek Tek veya Toplu Sayfa Transferi

[TURKOLOG]

Herkese Merhaba
2 tane userformum var

1. Userform Dışarı Aktarma Modülü
Mevcut excel dosyası içerisinde bulunan izin verilen sayfalar Listbox1 de görünüyor.
Dışarı aktarma için pdf mi excel mi yoksa hem pdf hem excel formatında mı aktarılacağı mutlak seçilmek sureti ile
Listbox1 de seçilen sayfalar veya Tüm Sayfaları Dış Ortama Aktar seçili ise tümü seçiliyor
Konum seç ve aktar tuşuna basınca dış ortama kaydedileceği yeri seçmek için pencere açılsın ve konumu seçince istenilen format ya da formatlarda (pdf xls) kaydetsin

2. Userformum İçeri Aktarma Modülü
Bu user form kaynak dosyada yine
Öncelikle hedef dosyayı seçmek için konumdan hedef dosyayı seçecek
Listbox1 den hedef dosyada olan dosyalar görünecek
tek tek listbox1den ya da toplu olarak Tüm Sayfaları İç Ortama Aktar seçildiğinde tüm sayları iç ortama aktaracak
Ama öncelikle sayfa ismi uyuşanları aynı sayfanın üzerine yazı tipi büyüklüğü tabloları ile hiç değiştirmeden. Eğer hedef dosyada olup da kaynak dosyada olmayan sayfa varsa onu da yeni bir sayfa açıp kaydedecek.

Yardım edebilecek olan varsa çok sevinirim.

Dış Bağlantı İndirme Linki

 

[TURKOLOG]

Bu konuda yardımcı olabilecek kimse var mı acaba

 

[TURKOLOG]

Bu kodlarla sormadan hedefteki tüm dosyaları kaynak dosya içerisine aktarıyor

Private Sub CommandButton1_Click()
Set x = CreateObject("Scripting.FileSystemObject")
With Application.FileDialog(msoFileDialogOpen)
.AllowMultiSelect = True
.Show
If .SelectedItems.Count = 0 Then Exit Sub
dosya = .SelectedItems(.SelectedItems.Count)

If x.GetExtensionName(dosya) Like "xls*" Then
Workbooks.Open dosya
For Each a In Workbooks(Dir(dosya)).Sheets
a.Copy After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)
Next
Workbooks(Dir(dosya)).Close
End If
End With
End Sub

Bu kodlarla da hedef dosyadaki tek tek sayfaları sorarak içeri aktarıyor

Private Sub CommandButton1_Click()
Set x = CreateObject("Scripting.FileSystemObject")
With Application.FileDialog(msoFileDialogOpen)
.AllowMultiSelect = True
.Show
If .SelectedItems.Count = 0 Then Exit Sub
dosya = .SelectedItems(.SelectedItems.Count)
If x.GetExtensionName(dosya) Like "xls*" Then
Workbooks.Open dosya
For Each a In Workbooks(Dir(dosya)).Sheets
sor = MsgBox(a.Name & " Sayfası alınsınmı?", vbYesNo)
If sor = vbYes Then _
a.Copy After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)
Next
Workbooks(Dir(dosya)).Close
End If
End With
End Sub

Ama her iki kodda da
a.Copy After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count) kısmında hata verdi malesef. Yardım edebilecek olan var mı