• DİKKAT

    DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
    Altın Üyelik Hakkında Bilgi

Bir sayfayı başka bir çalışma kitabına kopyalamak

B

bycleveres

Katılım
16 Şubat 2012
Mesajlar
38
Excel Vers. ve Dili
excel 2003
tr
Merhaba arkadaşlar ,

örneğin ;

"deneme.xls" adında bir excel çalışma kitabım var ve içinde " sayfa1 , sayfa2.... sayfa5 " şeklinde oluşturduğum sayfalar var olsun.

Bilgisayarımda ise " D:\DOSYALAR\rapor.xls " şeklinde kayıtlı bir çalışma kitabım var olsun.

Yapmak istediğim şey şu ;

Yine "deneme.xls" çalışma kitabının içinde "kopyala" adında bir sayfa oluşturup bu sayfaya öyle bir makro buton kod vs. eklemeliyim ki ,

"deneme.xls" deki varolan " sayfa1 , sayfa2.... sayfa5 " sayfalarından istediğim bir sayfayı seçip yada ismini yazıpıp " D:\DOSYALAR\rapor.xls " içine aynı isim ve verilerle birebir kopyalayabilmek.

Bu mümkünmüdür ?

iyi çalışamalar.
 

Ekli dosyalar

Merhaba
Boş bir module kopyalayın ve deneyin.
A sütununa sayfa isimlerini ekleyin. Seçtiğiniz sayfayı aktarır.
Kod: 
Option Explicit
Sub aktar()
Dim XCL As Application, KTP As Workbook
Dim S1 As Worksheet
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Set S1 = Sheets(ActiveCell.Text)
Set KTP = Workbooks.Open("D:\rapor.xls")
S1.Copy after:=KTP.Sheets(KTP.Sheets.Count)
KTP.Save: KTP.Close
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub
 
teşekkür

sayın "halit3" cevap için teşekkür ederim.

bu işimi görecektir.

sayın "asi kral" kodu denemedim lakin çalışmadı ?
 
bycleveres' Alıntı:
sayın "halit3" cevap için teşekkür ederim.

bu işimi görecektir.

sayın "asi kral" kodu denemedim lakin çalışmadı ?
Genişletmek için tıkla ...

Kodu denemeden nasıl çalışmadığını anladınız ilginç.
Söylediklerimi yapmadınız kesin.
Bir yere aktaracağınız sayfanın adını yazın sonra o hücreyi seçin ve kodu deneyin. bakın bakalım çalışıyor mu_?
 
teşekkür

uyarınız için teşekkür ederim ,

tekrar denedim kodu denemiştim fakat modülün içerisine kopyalarken hata yapmışım. şimdi çalıştı.

sizden birşey daha rica edebilirmiyim ?

bu kodu biraz daha genişletip kopyalama yapacağı xls kullanıcıya seçtirip , kopylama bittiğinde kopyalama bitmiştir uyarı verdirebilirmiyiz.
 
Merhaba halit bey ,

bahsettiğiniz "var olan dasyayı aç içine bu sayfayı kayıt et" denedim fakat tam olarak benim istediğimi yapmıyor , butonun içinde olduğu sayfayı kopyalıyor , benim istediğim çalışma kitabımın içinde kayıtlı olan sayfalardan seçip o sayfayı başka çalışma kitabının içine birebir kopyalamak.

kodu o şekilde uyarlamamız mümkünmüdür?

iyi çalışmalar.
 
bycleveres' Alıntı:
Merhaba halit bey ,

bahsettiğiniz "var olan dasyayı aç içine bu sayfayı kayıt et" denedim fakat tam olarak benim istediğimi yapmıyor , butonun içinde olduğu sayfayı kopyalıyor , benim istediğim çalışma kitabımın içinde kayıtlı olan sayfalardan seçip o sayfayı başka çalışma kitabının içine birebir kopyalamak.

kodu o şekilde uyarlamamız mümkünmüdür?

iyi çalışmalar.
Genişletmek için tıkla ...

Aynı dosyada (Başka dosyaya bu dosyadaki seçilen sayfalrı kopyala) komut düğmesi ile açılan userformda seçtiğin veya seçilen bütün sayfaları istenen dosyaya kayıt yapıyor.
 
hata

Merhaba halit bey ,

onuda denemiştim onda da ekteki resimdeki hatayı veriyor ?

iyi çalışmalar.
 

Ekli dosyalar

  • hata1.jpg
    hata1.jpg
    77.1 KB · Görüntüleme: 23
bycleveres' Alıntı:
merhaba halit bey , yine aynı hatayı aldım ?
Genişletmek için tıkla ...

Niçin olmadı diyorsunuz anlamıyorum her halde güncellediğim dosyaya bakmadınız galiba sizin 1 nolu dosyanıza ekledim kodu deneme yaparak kontrol edin.
 

Ekli dosyalar

teşekkür ve yine hata

Merhaba halit hocam , öncelikle desteğiniz için teşekkür ederim.

bu kez başka bir hata aldım ve resim olarak ektedir. esas çalışma kitabımıda ekledim ve "kopyala" sayfasında sizin örneğinizi yaptım onu incelerseniz belkide yapmış olduğum hata varsa siz daha iyi farkedebilirsiniz.

Ayrıca ofice 2010 ortamında bu çalışıyorum ve dosylarımı 2003 formatında kayıt ediyorum , bundan kaynaklı bir durum olabilirmi ?

iyi çalışmalar.
 

Ekli dosyalar

bycleveres' Alıntı:
Merhaba halit hocam , öncelikle desteğiniz için teşekkür ederim.

bu kez başka bir hata aldım ve resim olarak ektedir. esas çalışma kitabımıda ekledim ve "kopyala" sayfasında sizin örneğinizi yaptım onu incelerseniz belkide yapmış olduğum hata varsa siz daha iyi farkedebilirsiniz.

Ayrıca ofice 2010 ortamında bu çalışıyorum ve dosylarımı 2003 formatında kayıt ediyorum , bundan kaynaklı bir durum olabilirmi ?

iyi çalışmalar.
Genişletmek için tıkla ...

kodun bu bölümünü

Kod: 
say1(i) = ActiveWorkbook.VBProject.VBComponents(Worksheets(i).CodeName).CodeModule 'Sheets(i).Name '

bununla değiştirim bir deneyin

Kod: 
say1(i) = Worksheets(i).CodeName
 
hocam tamamdır , hata giderildi ve istediğim gibi kopylamayı yapıyor.

katkınızdan dolayı teşekkür ederim.

iyi çalışmalar.
 
ek bir soru

Merhaba sayın "halit3" ,

konu açmadan ek olarak birşey sormak istiyorum , kopyalayacağımız sayfada formüller var hepsi çalıştı ve hücrelere rakamları yazdı ve kaydettim.

kopya sayfa oluştururken sadece hücrelerdeki verileri alsa formülleri almasa diyorum. yani yeni kopya olan sayfada hücreler formülsüz olsa.

sizin makrolar silinsin mi seçeneği gibi düşünün.

bu halledebilirsek çok memnun olurum.

iyi çalışamalar.
 
bycleveres' Alıntı:
Merhaba sayın "halit3" ,

konu açmadan ek olarak birşey sormak istiyorum , kopyalayacağımız sayfada formüller var hepsi çalıştı ve hücrelere rakamları yazdı ve kaydettim.

kopya sayfa oluştururken sadece hücrelerdeki verileri alsa formülleri almasa diyorum. yani yeni kopya olan sayfada hücreler formülsüz olsa.

sizin makrolar silinsin mi seçeneği gibi düşünün.

bu halledebilirsek çok memnun olurum.

iyi çalışamalar.
Genişletmek için tıkla ...

Bu kod sayfadaki hücrelere ait ne kadar veri varsa hepsini tek tek bakarak işlem yapıyor tabi çok veri olursa buda hayli bir zaman demek birleştirilmiş hücreler olduğu için bu yolu kullandım aktarmalar ona göre kısa veya uzun zaman sürmektedir.


kod:

Kod: 
Private Sub CheckBox1_Click()
Dim i As Integer
For i = 1 To ListBox1.ListCount
ListBox1.Selected(i - 1) = CheckBox1.Value
Next
End Sub
 
Private Sub CommandButton1_Click()
Dim say1(500)
[COLOR=red]Dim say2(500)[/COLOR]
Dim myArray() As Variant
Dim i As Integer
son = 0
For i = 1 To ListBox1.ListCount
If ListBox1.Selected(i - 1) = True Then
son = 1
End If
Next
If son = 0 Then
MsgBox "Sayfa seçimi yapmadınız"
Exit Sub
End If
 
dosya_adı = ActiveWorkbook.Name
Sayfa_Adı = ActiveSheet.Name
Dosya_Yolu = Application.GetOpenFilename(FileFilter:="Excel Files (*.xls*), *.xls*")
If Dosya_Yolu = False Then
MsgBox "Veri alınacak dosyayı seçmediniz.", vbInformation, "DİKKAT"
Exit Sub
Else
End If
Dim wb As Workbook
On Error Resume Next
Set wb = Workbooks.Open(Dosya_Yolu)
For i = 1 To ActiveWorkbook.Sheets.Count
say1(i) = Worksheets(i).CodeName
[COLOR=red]say2(i) = Sheets(i).Name[/COLOR]
Next i
a = MsgBox("Sayfadaki makrolar silinsinmi.?", vbYesNo + vbInformation, " uyarı")
yeni_dosya_adı = ActiveWorkbook.Name
Windows(dosya_adı).Activate
n = 0
For i = 1 To ListBox1.ListCount
r = 0
If ListBox1.Selected(i - 1) = True Then
r = 1
End If
If r = 1 Then
ReDim Preserve myArray(n)
myArray(n) = i
n = n + 1
End If
Next
Sheets(myArray).Select
Sheets(myArray).Copy Before:=Workbooks(yeni_dosya_adı).Sheets(1)
Windows(yeni_dosya_adı).Activate
 
[COLOR=red]For k = 1 To ActiveWorkbook.Sheets.Count[/COLOR]
[COLOR=red]say5 = 0[/COLOR]
[COLOR=red]For j = 1 To ActiveWorkbook.Sheets.Count[/COLOR]
[COLOR=red]If Sheets(k).Name = say2(j) Then[/COLOR]
[COLOR=red]say5 = 1[/COLOR]
[COLOR=red]Exit For[/COLOR]
[COLOR=red]End If[/COLOR]
[COLOR=red]Next j[/COLOR]
[COLOR=red]If say5 = 0 Then[/COLOR]
[COLOR=red]ActiveWorkbook.Worksheets(k).Select[/COLOR]
[COLOR=red]If WorksheetFunction.CountA(Cells) > 0 Then[/COLOR]
[COLOR=red]sat = Cells.Find(What:="*", After:=[A1], SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row[/COLOR]
[COLOR=red]sut = Cells.Find(What:="*", After:=[A1], SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column[/COLOR]
[COLOR=red]Dim X As Range[/COLOR]
[COLOR=red]For Each X In Range(Cells(1, 1), Cells(sat, sut))[/COLOR]
[COLOR=red]X.Value = X.Value[/COLOR]
[COLOR=red]Next X[/COLOR]
[COLOR=red]End If[/COLOR]
[COLOR=red]End If[/COLOR]
[COLOR=red]Next k[/COLOR]
 
If a = vbYes Then
For Each component In ActiveWorkbook.VBProject.VBComponents
If component.Type <> 100 Then
Else
Set modul = component.CodeModule
If modul.Name <> "ThisWorkbook" Then
For j = 1 To ActiveWorkbook.Sheets.Count
If say1(j) = modul.Name Then
modul.DeleteLines 1, modul.CountOfLines
sat1 = sat1 + 1
ActiveWorkbook.Worksheets(sat1).Select
ActiveWorkbook.Worksheets(sat1).DrawingObjects.Delete
Exit For
End If
Next j
End If
End If
Next
End If
 
ActiveWorkbook.Save
ActiveWindow.Close
Windows(dosya_adı).Activate
Sheets(Sayfa_Adı).Select
ActiveWindow.WindowState = xlMaximized
MsgBox "işlem tamam"
End Sub
 
Private Sub UserForm_Initialize()
ListBox1.ListStyle = 1
ListBox1.MultiSelect = 1
For i = 1 To ActiveWorkbook.Sheets.Count
ListBox1.AddItem Sheets(i).Name
Next i
End Sub
 
teşekkür ve bir hata

Merhaba Halit hocam,

cevabınız için teşekkür ederim kodu aynen denedim belirttiğiniz gibi işlemi yapıyor fakat sadece 1 satırda hata vererek sonlandırıyor.

hata resmi ektedir.

müsaitseniz inceleyebilirmisiniz.

tekrar teşekkürler , iyi çalışmalar.
 

Ekli dosyalar

  • hat.jpg
    hat.jpg
    33.4 KB · Görüntüleme: 4
Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst