Dosyadan dosyaya değerleri ile veri aktarmak.

[deliceli]

Bütün Arkadaşlara, Ustalara MERHABA.!
Foruma yapılan saldırıyı şiddetle kınıyorum.
Arkadaşlar,Forumda veri aktarmak ile ilgili konulara bakerken Leumruk kardeşimin yaptığı tabloyu gördüm ve inceledim.Düşüncelerimi de cevap olarak yazdım.
Ancak cevap gelmedi.Makro kısmına taşırsam daha çok cevap geleceğini düşündüm ve burada yeni konu açtım.Yanlış yapmışsam özür dilerim.
Ben çalıştığımız excel dosyasından başka bir dosyaya sadece hücrelerdeki verileri "DEĞER" olarak her kişiye yeni bir sayfa açarak verileri aktarmak istedim.Leumruk kardeşimin yazdığı kodları bilgim nisbetinde değiştirip uyarlamaya çalıştım, ama maalesef beceremedim.
Yardımlarınızı bekliyorum.Dosyayı ekliyorum.Lütfen inelermisiniz.
Hepinize sağlıklı ve başarılı günler diliyorum.Selamlar....

 

[deliceli]

Merhabalar;
Konu hakkında bilgisi olan ustalardan yardım bekliyorum.Selamlar...

 

[deliceli]

Çalışma sayfasını "D" deki başka klasöre değerleri ile Yedeklemek.

Merhabalar;
Sayın arkadaşlar;Ben galiba yukarıda istediğimi iyi anlatamadım.Sizlerin değerli vakitlerinizi alacağımdan dolayı özür dilerim.Ancak kendim çok fazla anlamadığım için yapamadım.Bu nedenle yeni bir sayfa ekliyorum.

1- Bu sayfayı "D:\BİLDİRİM\YEDEK" isimli klasöre yedeklemek istiyorum.
2- Yedeklerken sayfa isimlerini D2 hücresindeki isimden alacak.
3- Yedeklerken her isme "D:\BİLDİRİM\YEDEK" klasöründe ayrı ayrı sayfa açacak.
4- Yedekleme yapılırken çizgiler ,biçimler ve boyutlar bu sayfadakiler ile aynı olacak, fakat formulleri değil sadece hücre değerleri ile yedeklenecek.

Aşağıdaki kodları daha önce forumdan indirdim.Bu kodlar aynı çalışma sayfasına ekliyor.Ben ise "D:\BİLDİRİM\YEDEK" isimli klasöre yedeklemek istiyorum.Bu kodlar hücredeki formülleri aynen yedeklediği için sorun teşkil ediyor.Bu kodları yukardaki bilgilere göre ustalarımızın uyarlamasını veya yeni bir kod yazmasını rica ediyorum.

Option Explicit
Sub AKTAR()
Application.ScreenUpdating = False
Application.CopyObjectsWithCells = False
Dim S1 As Worksheet
Set S1 = Sheets("AnaSayfa")
S1.Select
If [A5] <> "" Then
If SAYFA([A5]) Then
S1.Cells.Copy Sheets([A5].Text).[A1]
Else
Worksheets.Add , After:=Sheets(Worksheets.Count)
ActiveSheet.Name = S1.[A5]
S1.Cells.Copy ActiveSheet.[A1]
End If
S1.Select
MsgBox "İşleminiz tamamlanmıştır.", vbInformation
Else
End If
Set S1 = Nothing
Application.CopyObjectsWithCells = True
Sheets("AnaSayfa").Select
End Sub

Function SAYFA(SAYFAADI As String) As Boolean
On Error Resume Next
SAYFA = CBool(Len(Worksheets(SAYFAADI).Name) > 0)
End Function

Lütfen yardım ediniz.Selam ve saygılarımla hepinize iyi günler dilerim.

 

[tahsinanarat]

dosyanız ekte

Yedekal düğmesine basın, yedeklemeden sonra kendi kaydetmeden kapatacaktır.

 

[deliceli]

Merhabalar;
Sayın tahsinanarat bey ilgilendiğiniz için çok teşekkür ederim.Fakat tam olarak benim yapmak istediğim gibi olmamış .Çalıştığımız sayfayı "D:\BİLDİRİM\YEDEK" klasörüne yedeklerken çalışma sayfası kapanmayacak ve hücrelerde bulunan formuller değer olarak kopyalanacak.(Kopyala/özel yapıştır/değerleri ) bunu makroda yazmalıyız.
Hücrelerdeki formülleri formül olarak yedeklediğimizde Orjinal dosyadaki veriler değiştikçe yedeklediğimiz klasöerdeki dosyalardaki verilerde değişiyor.Verilerin sabit olması değişmemesi için hücredeki verileri değerleri ile aktarmamız gerekiyor.
inşallah anlatabilmişimdir.
Tekrar teşekkür eder yardımlarınızı bekliyorum.İyi çalışmalar dilerim.

 

[hsayar]

d2 deki isimle aynı isem sahip dosya varsa ne olacak?
b2:n38 aralığındaki verileri istiyorsunuz, sayfanın tamamınımı
gizli sütunlar hariç mi olacak?

 

[deliceli]

d2 deki isimle aynı isem sahip dosya varsa ne olacak?

Sayın Hsayar;
D2 hcresindeki isimle aynı isme sahip dosya olursa dosyanın üzerine yazacak.Sebebi ise D2 hücresindeki isimler devamlı değişmekte.Her isimden bir adet olacak.Gizli sutunlar hariç olacak.
İlgilendiğiniz için çok teşekkür eder, esenlikler dilerim.

 

[Korhan Ayhan]

Selamlar,

Aşağıdaki kodu denermisiniz.

Option Explicit
 
Sub YEDEKLE()
    Dim S1 As Worksheet
    Set S1 = Sheets("bildirim")
    Application.ScreenUpdating = False
    S1.Select
    If [D2] <> "" Then
    S1.Copy
    Cells.Copy
    Cells.PasteSpecial Paste:=xlPasteValues
    Application.CutCopyMode = False
    Range("A2").Select
    Application.DisplayAlerts = False
    ActiveWorkbook.SaveAs Filename:="D:\BİLDİRİM\YEDEK\" & S1.[D2] & ".xls", FileFormat:=xlNormal, _
    Password:="", WriteResPassword:="", ReadOnlyRecommended:=False, CreateBackup:=False
    ActiveWorkbook.Close
    Application.DisplayAlerts = True
    End If
    Set S1 = Nothing
    Application.ScreenUpdating = True
    MsgBox "İşleminiz tamamlanmıştır.", vbInformation
End Sub

 

[deliceli]

Merhabalar;
Sayın Korhan Ayhan gecenin 04.11 inde uykunuzdan fedakarlık yapıp ilgilendiğiniz için samimiyetle teşekkürlerimi sunarım.Ayrıca ilgilenen diğer arkadaşlarada teşekkür ediyorum.
Sayın Korhan Ayhan' ın yazdığı kodlar işimi gördü.Hepinize sağlıklı günler ve başarılar dilerim.Saygı ve selamlarımı sunarım.