Ana Dosyaya diğer dosyadaki sayfayı Taşıma/Kopyalama

[cimcoz]

Merhaba,

Kapalı durumda bulunan "Deneme" adlı dosyamdaki "Sheet1" sayfasını "Anasayfa" adlı dosyama "YeniSayfa" adı ile taşımak ya da kopyalamak istiyorum.
(Taşıma/kopyalama yapılırken Sheet1 sayfa adı "YeniSayfa" olarak değişmesi gerekiyor)

Bunu açık durumda olan Anasayfa dosyamdaki Sheet3'te bulunan "Sayfayı Getir" makrosuna tıklayıp almak istiyorum.

(Dosya adları ve sayfa adları sabit olacaktır.)

Örnek dosyalar ektedir.

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

Saygılarımla,

 

[halit3]

kod:

Sub Başka_Dosyadan_Sayfayı_Taşıyarak_Kopyala()
dosya_adı = ActiveWorkbook.Name
Sayfa_Adı = ActiveSheet.Name

a = Application.GetOpenFilename(FileFilter:="Excel Workbooks,*.xls*", Title:="Open a File", MultiSelect:=False)
If a = False Then
MsgBox "Kaynak klasörü seçmediniz"
Exit Sub
End If

sayfaadı = "[COLOR="Red"]Sheet1[/COLOR]"
sayfa = "[COLOR="red"]YeniSayfa[/COLOR]"

If a = False Then
MsgBox "Veri alınacak dosyayı seçmediniz.", vbInformation, "DİKKAT"
Exit Sub
Else
End If

Dim wb As Workbook

Set wb = Workbooks.Open(a)
yeni_dosya_adı = ActiveWorkbook.Name
Windows(yeni_dosya_adı).Activate
Sheets(sayfaadı).Select

Application.DisplayAlerts = False
Sheets(sayfaadı).Copy Before:=Workbooks(dosya_adı).Sheets(1)
'On Error Resume Next
For i = 1 To ThisWorkbook.Sheets.Count
If Sheets(i).Name = sayfa Then
MsgBox sayfa & " mevcut var"
GoTo atla
End If
Next

Sheets(ActiveSheet.Name).Name = "YeniSayfa"
atla:
Windows(yeni_dosya_adı).Activate
Application.DisplayAlerts = False

ActiveWindow.Close
Windows(dosya_adı).Activate
Sheets(Sayfa_Adı).Select
ActiveWindow.WindowState = xlMaximized
MsgBox "işlem tamam"

   
End Sub

Ayrıca alternatif olarak aşağıdaki linki irdeleyiniz.
http://www.excel.web.tr/f133/klasor-ve-dosya-olu-turma-secenekleri-t68040.html

 

[cimcoz]

Sayın halit3,

Tam istediğim gibi oldu.

Çok teşekkür ederim, ellerinize sağlık.


Saygılarımla,