Hücre Adıyla Farklı Kaydeden Makro

[halit3]

malesef hocam çalıştıramadım

tamam kodda hata varmış

düzelttim

 

[halit3]

hocam sorunum sayfa1 e girdiğim verleri otomatik sayfa 2 ye atıyor. I3 hücresindeki isimle farklı kaydetmek istiyorum. (sadece sayfa 2 yi kaydetmek istiyorum onuda sayfa biçimi aynı,formülleri değer olarak istiyorum.yardımlarınız için şimdiden teşekkür ederim.

bu kodu denermisiniz.

Sub çalışmakitabıyap()
deger = Worksheets("Sayfa2").Cells(3, 9).Value
deger1 = InputBox("Sayfanın adını değiştirebilirsiniz.", "UYARI!", ActiveSheet.Name)
Sayfa_adı = "Sayfa2"
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.Copy
Sheets(ActiveSheet.Name).Name = deger1
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

 

[ilhan40]

hocam Sayfanın adını değiştirebilirsiniz mesajı geliyor tamam dedim Kaynak Dosyaları İçeren Klasörü Seçin mesajı geldi masaüstü tamam dedim ama olmadı

 

[halit3]

hocam Sayfanın adını değiştirebilirsiniz mesajı geliyor tamam dedim Kaynak Dosyaları İçeren Klasörü Seçin mesajı geldi masaüstü tamam dedim ama olmadı

ne hatası veriyor

 

[ilhan40]

hata vermiyor ama sayfa2 deki I3 hücresindeki isimle farklı kaydetmesi gerkiyor ama kaydetmiyor

 

[ilhan40]

dosya ekte

 

[halit3]

hocam sorunum sayfa1 e girdiğim verleri otomatik sayfa 2 ye atıyor. I3 hücresindeki isimle farklı kaydetmek istiyorum. (sadece sayfa 2 yi kaydetmek istiyorum onuda sayfa biçimi aynı,formülleri değer olarak istiyorum.yardımlarınız için şimdiden teşekkür ederim.


20 nolu mesajında

I3 hücresindeki değere göre kayıt etmek istemişsin
oysa senin kayıt edeceğin veri I2 hücresinde

 

[ilhan40]

hocam pardon I2 hücresi(deneme 3) adıyla farklı kayıt edeceğim

 

[halit3]

hocam pardon I2 hücresi(deneme 3) adıyla farklı kayıt edeceğim

burayı

deger = Worksheets("Sayfa2").Cells([COLOR=red]3[/COLOR], 9).Value

burayla değiştir

deger = Worksheets("Sayfa2").Cells([COLOR=red]2[/COLOR], 9).Value

 

[halit3]

hocam pardon I2 hücresi(deneme 3) adıyla farklı kayıt edeceğim

ekli dosyaya bir bakınız.

 

[peleryn]

Halit hocam merhaba;

Biliyorum sizin için de benim için de sıkıcı olmaya başladı ama çoğu bitti azı kaldı.21 nolu mesajdaki dosyada kaydetme sorunu halledildi ancak tek bir sorunum var.Dosya içerisinde yptığım değişikliklerle yeni bir dosya açmıyor dosyanın ilk haliyle yeni bir dosya açıyor.

 

[halit3]

hemen kodun ilk başlangıcına
Sub kayıtet()
ActiveWorkbook.Save


bunu ekle

kırmızı yazı ile yazılan kodu ekle

 

[peleryn]

Denedim hocam birşey değişmiyor bir de bazen konumda kayıtlı dosya yokken bile bu konumda ... adlı dosya zaten var... uyarısı veriyor ve herhangi bir dosya kaydetmeyebiliyor.Gizli dosyalar mı var dedim araçlardan göster seçeneğini seçtim dosya yine yok..

 

[ilhan40]

hocam eline ve emeğine sağlık bir iki düzenleme için tekrar bakabilirseniz sevinirim

 

[halit3]

Denedim hocam birşey değişmiyor bir de bazen konumda kayıtlı dosya yokken bile bu konumda ... adlı dosya zaten var... uyarısı veriyor ve herhangi bir dosya kaydetmeyebiliyor.Gizli dosyalar mı var dedim araçlardan göster seçeneğini seçtim dosya yine yok..

tamamdır herhalde kayıt fonksiyonunu değiştirdim.

 

[peleryn]

Hocam sabırla uğraştınız teşekkür ederim sonunda oldu dosyama da uyarladım çalışıyor ellerinize sağlık

 

[halit3]

hocam eline ve emeğine sağlık bir iki düzenleme için tekrar bakabilirseniz sevinirim

sizinkide tamamdır herhalde

 

[halit3]

Hocam sabırla uğraştınız teşekkür ederim sonunda oldu dosyama da uyarladım çalışıyor ellerinize sağlık

iyi çalışmalar

 

[ilhan40]

hocam teşekkürler eline saglık

 

[halit3]

hocam teşekkürler eline saglık

iyi çalışmalar