dışarıdan dosya aç yöntemiyle sayfa taşıma

[alirizapekbilir]

dışarıdan dosya aç yöntemiyle herhangi bir kitaptaki sayfaları aktif çalışan kitaba aktarmak yapmak istiyorum makro ile

 

[PLİNT]

Merhaba
Aşağıdaki kodları denermisiniz?
Kitabı açıp "Sayfa1" 'i kopyalayıp almak için

Workbooks.Open ThisWorkbook.Path & "\" & "Kitap.xlsx"
Workbooks("Kitap.xlsx").Sheets("Sayfa1").Copy After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)
Workbooks("Kitap.xlsx").Close

Sayfaların hepsini kitabı açmaya gerek kalmadan, almak için;

Dim wb As Workbook, ws As Worksheet, i As Integer
Set wb = ThisWorkbook
wb.Sheets.Add Type:=ThisWorkbook.Path & "\Kitap.xlsx"
i = wb.Sheets.Count
Set ws = ActiveSheet
ws.Move After:=wb.Sheets(i)

 

[alirizapekbilir]

olmadı usta yapamadım istiyorumki dosya aç deyip dosyayı bulayım dosya adı değişken

 

[PLİNT]

Aşağıdaki örnekle dosya seçtiğinizde; tüm sayfaları kod bulunan dosyaya ekleyecektir
http://s7.dosya.tc/server/37zdow/Deneme.zip.html

[SIZE="2"]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[/SIZE]

Bu örnektede seçtiğiniz dosyayı açıp size sorarak alacaktır.
http://s7.dosya.tc/server/t1ao8w/Deneme2.zip.html

[SIZE="2"]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[/SIZE]

 

[alirizapekbilir]

deneme

teşekkürler çok güzel olmuş elinize sağlık