excelde sayfayı klasöre taşıma

[aydın3838]

selamlar

excelde 5 adet sabit sayfam var bu sayfalardan 1 tanesi şablon sayfa

yeni sayfa ekleyip şablon sayfayı kopyala yapıştır yapıp bu sayfayı

klasöre kopyalıyorum fakat tekrar excele dönüp 5 sabit sayfayı gizleyip klasöre kopyalanmış sayfayı silmem gerekiyor

yukarıda anlattığım şekilde kodlarım var

fakat benim istediğim yeni eklediğim sayfayı direkt klasöre taşıma

böyle bir kod varmı acaba işlemler çok uzun sürüyor kısaltma yapılması için

 

[aydın3838]

kullandiğim kod bu bu kodu daha hızlı ve sadeleştirmem gerekiyor sayfaları gizlemeden silmeyi

Dim Dosya_Adı As String
Application.ScreenUpdating = False
For i = 1 To Worksheets.Count
Dosya_Adı = ""
Sheets(i).Select
xx = Sheets(i).Name
Sheets(i).Copy
Dosya_Adı = "" & xx & ".xls"
ActiveWorkbook.SaveCopyAs Filename:="C:\Users\AYDIN ISI CAM\Desktop\AYDIN CAM KAYIT\MÜŞTERİ KARTLARI" & Application.PathSeparator & Dosya_Adı
ActiveWorkbook.Close 0
Next
Application.ScreenUpdating = True
MsgBox "Yedekleme işlemi tamamlanmıştır.", vbInformation, "aydın cam"

Sayfa1.Visible = False
Sayfa3.Visible = False
Sayfa5.Visible = False

Application.DisplayAlerts = False
Sheet.Activate
ActiveSheet.Delete

Sheets("sayfa1").Visible = True
Sheets("ANA").Visible = True
Sheets("MÜŞTERİ KARTI").Visible = True

 

[halit3]

aradığın aşağıdaki linkdeki 7 nolu mesajda var
http://www.excel.web.tr/f133/klasor-ve-dosya-olusturma-secenekleri-t68040.html

dosyayı açtıktan sonra düğmelerdeki makrolardan bir tanesi işini görecektir iyi kontrol et

 

[aydın3838]

sayın halit bey teşekkürler

ben sizin bir kaç çalışmanızı inceledim önerinizide inceledim

fakat ben biraz acemilerdenim kodları kendime çeviremiyorum

ya hata veriyor yada işlemi yapmıyor

yukarıdaki koda bakılırsa olay anlaşılır kitabı komple aktarmayacak sadece yeni eklenmiş sayfayı

klasöre taşıyacak

teşekkürler

 

[halit3]

sayın aydın3838
"bu sayfayı çalışma kitabı yap"
düğmesine ait makroyu kullanacaksın

 

[aydın3838]

sayın hocam
sizin örnekte
1 inputpuxtan sayfa ismi alıyor hadi onu geçtik çünkü sayfa ya ben isim veriyorum

2 aktif sayfayı aktarıyor

3 sayfayı kopyalıyor yani aktif sayfada kod çalıştırılıyor
klasör manuel seçiliyor seçili klasöre sayfanın kopyasını kaydediyor
sayfanın asılı yini kitapta kalıyor

benim istediğimse sayfayı olduğu gibi benim müşteri kartları adındaki klsöre sayfayı kommple

taşıması neden derseniz excel şişmesin derim çünki şişiyor sizde bilirsinizki

yaklaşık yılda 300 ,500 sayfa müşteri kaydı olur bu büyük bir yer sıkıntısıdır

benim programda sürekli kalması gereken 5 sayfa var.yeni sayfa ekledikten sonra şablon sayfayı
kopyalayıp isim veriyorum ve bu sayfanın da komple taşımam gerekiyor

ben sayfa taşı derken bunu anlatmaya çalıştım

tekrar teşekkürler sayın halit bey

 

[halit3]

ActiveWorkbook.Close False

yukarıdaki koddan sonra aşağıdaki kodu eklersen düzelir
Application.DisplayAlerts = False
ActiveSheet.Delete
Application.DisplayAlerts = True

 

[aydın3838]

birkaç ana sayfa var kalması gereken onların silinmemesi gerekiyor
nasıl bir ilave yapılır

ben gizlemeyi denedim olmadı yukarıdaki kodda var

 

[aydın3838]

birkaç ana sayfa var kalması gereken onların silinmemesi gerekiyor
nasıl bir ilave yapılır

ben gizlemeyi denedim olmadı yukarıdaki kodda var

sayın halit bey özür dilerim yanlış soru oldu

dosya konumunu bana sormadan sabit bir dosyam var

inputbux u kullanmada direkt yapsa işlemi olurmu

tekrar özür dilerim yanlışlık için

saygılar

 

[halit3]

aşağıdaki kodu denermisiniz sayfayı taşıyor ve adıyla dosya oluşturuyor



Sub aktar()
deger = InputBox("Sayfanın adını değiştirebilirsiniz.", "UYARI!", ActiveSheet.Name)
'dosya_adı = ActiveWorkbook.Name
Sayfa_adı = ActiveSheet.Name
On Error Resume Next
Dim Baslik As String
Baslik = "Kaynak Dosyaları İçeren Klasörü Seçin"
Set Obj = CreateObject("shell.application")
Set Klasor = Obj.BrowseForFolder(0, Baslik, 50, &H0)
kaynak = Klasor.items.Item.Path
If Len(kaynak) = 3 Then
kaynak = Mid(kaynak, 1, 2)
Else
kaynak = kaynak
End If
If Not Klasor Is Nothing Then
If InStr(1, kaynak, "{") > 0 Then GoTo Atla
On Error Resume Next
Dim sayfa As Worksheet
For Each sayfa In Worksheets
MsgBox Worksheets
If sayfa.Name = Sayfa_adı Then
sayfa.Move
Sheets(ActiveSheet.Name).Name = deger
ActiveWorkbook.SaveAs kaynak & "\" & deger & ".xls"
ActiveWorkbook.Close False
Exit Sub
End If
Next sayfa
Else
Atla:
MsgBox "Lütfen Kaynak Klasör Seçimini Yapınız !", vbInformation, "DİKKAT"
End If
End Sub

 

[aydın3838]

sayın halit bey

("C:\Users\AYDIN ISI CAM\Desktop\AYDIN CAM KAYIT\MÜŞTERİ KARTLARI\*.xls")

ben nereye yazayım

bu benim dosyanın adresi

sizin kodda adresi biz belirliyoruz bunu otomatik yapsın

teşekkürler

 

[halit3]

aşağıdaki kodu denermisin

Sub aktar()
deger = InputBox("Sayfanın adını değiştirebilirsiniz.", "UYARI!", ActiveSheet.Name)
'dosya_adı = ActiveWorkbook.Name
Sayfa_adı = ActiveSheet.Name
kaynak = ("C:\Users\AYDIN ISI CAM\Desktop\AYDIN CAM KAYIT\MÜŞTERİ KARTLARI")
On Error Resume Next
Dim sayfa As Worksheet
For Each sayfa In Worksheets
MsgBox Worksheets
If sayfa.Name = Sayfa_adı Then
sayfa.Move
Sheets(ActiveSheet.Name).Name = deger
ActiveWorkbook.SaveAs kaynak & "\" & deger & ".xls"
ActiveWorkbook.Close False
Exit Sub
End If
Next sayfa
End Sub

 

[aydın3838]

tesekkür ederim iyi aksamlar