Macro ile kopyalayıp özel yapıştır ile başka bir ad ile dosya oluşturmak

[levoni]

Arkadaşlar Merhaba,
Bir konuda yardımınıza ihtiyacım var.Öncelikle bu kadar basit bir şey için macro yazılırmı diye düşünebilirsiniz ancak bu işlem bir çok işlemin bir devamınde gelen bir konu olduğu için bu macro ile yapmayı düşündüm.
Yapmak istediğim şey şu içerisinde bir çok formül olan bir excel sheeti ni macro ile içerisindeki tüm alanları seçip seçtikten sonrada başka bir isim ile formülsüz olarak kaydetmek istiyorum.Kısaca başka bir isim altında bulunduğu klasörün içerisine formülsüz olarak kayedetmek istiyorum.
aşağıda biraz araştırdım bazı şeyler buldum ama yapıştırma ve başka dosya ismi ile kaydetme işlemlerini yapamadım.

Sub Used_Range()
ActiveSheet.UsedRange.Select
End Sub
Sub kopyala()
ActiveSheet.UsedRange.Copy
End Sub

Yardımcı olabilirseniz çok sevinirim. Örnek dosya koymadım ihtiyaç olacağını düşünmedim eğer isterseniz hazırlayıp ekleyebilirim.


Şimdiden tşk ler

Sub Used_Range()
ActiveSheet.UsedRange.Select
End Sub
Sub kopyala()
ActiveSheet.UsedRange.Copy
End Sub

 

[İhsan Tank]

Merhaba
Dosya ekler misiniz_?

 

[levoni]

İhsan Bey merhaba,
ilginiz için çok tşk ler.
Ekte hazırladığım "Örnek Formüllü Dosya.xlsx" dosya ile olması gereken yani formüllerden kurtulmuş hali ile" Olması Gereken Dosya_25112011_Stok Raporu.xlsx" dosyasını gönderiyorum.
Olması gereken dosya formllü dosya hangi klasörün içerisinde yer alıyorsa aynı klasörün içerisine oluşturması gerekiyor (tabi mümkünse )

tşk ler

 

[irfancantr]

Daha önceden kendim için ustalardan benzer birşey istemiştim. İstediğin sayfaları formülsüz istediğin bir kitap haline getiriyor.

 

[levoni]

İrfancantr bey dosya için çok tşk ler.
Bu dosya benim başka bir işimde çok faydalı olacaktır ve kullanırım.Ancak bu yukarda istediğim işlem bir dizi macro işlemlerinin sonucunda oluşan bu dosya olduğundan süreci tamamlamak için gönderdiğim örnek üzerinden ilerlemem gerekiyor.

iyi çalışmalar

 

[levoni]

İhsan Tank Bey herhalde şuan forumda olmadığından başka arkadaşlar eğer mümkünse yardımcı olabilirler mi acaba ?
tşk ler

 

[İhsan Tank]

İhsan Tank Bey herhalde şuan forumda olmadığından başka arkadaşlar eğer mümkünse yardımcı olabilirler mi acaba ?
tşk ler

Dosyalara baktım ama dış dosyadan veri alıyor bir de bazı yerlerde hata vermiş isterseniz onları düzeltin ve diğer dosyayı da ekleyin bakıp yardımcı olmaya çalışayım.

 

[levoni]

ihsan Bey ,
kusura bakmayın sizi uğraştıryorum. Sizi bulmuşken vakit kaybetmemek için sadece bir kaç alana örnek olsun diye basit formüller yazdım.Dediğiniz gibi diğerleri dış kaynaktan veri alıyor.
Şöyle düşünmek mümkün olurmu acaba ?lütfen saygısızlık olarak algılamayın ,
ilgili dosyadaki tüm verileri sanki excelin en sol üst köşesindeki kutucuğa basarak tümünü seçili hale getirip sonrada A1 hücresine özel yapıştır ile değerleri yapıştıracak.

Vaktinizi basit konulardan dolayı meşgul ettiysem lütfen kusura bakmayın .
iyi çalışmalar

 

[İhsan Tank]

ihsan Bey ,
kusura bakmayın sizi uğraştıryorum. Sizi bulmuşken vakit kaybetmemek için sadece bir kaç alana örnek olsun diye basit formüller yazdım.Dediğiniz gibi diğerleri dış kaynaktan veri alıyor.
Şöyle düşünmek mümkün olurmu acaba ?lütfen saygısızlık olarak algılamayın ,
ilgili dosyadaki tüm verileri sanki excelin en sol üst köşesindeki kutucuğa basarak tümünü seçili hale getirip sonrada A1 hücresine özel yapıştır ile değerleri yapıştıracak.

Vaktinizi basit konulardan dolayı meşgul ettiysem lütfen kusura bakmayın .
iyi çalışmalar

1. Saygısızlık demeyin her fikre açığız olursa öyle yapılır olmazsa başka yöntemler kullanılır ( aynı bunda olduğu gibi )
2. Basit konu dediğiniz biraz yanlış olmuş. Basitse herkes yapar basit değilse azcık bilen yardımcı olur.
3. Meşguliyet boş vakit buldukça burada yardım etmeye çalışıyorum.
Olması Gereken Dosyada boş bir module oluşturun ve içine

Option Explicit
Sub kopya_61()
Dim ts, kaplan, trabzonspor, hamsi As Date
Dim bordo, mavi, asi
trabzonspor = MsgBox("Verileri Kopyalıyorum", vbYesNo, "Onay")
If trabzonspor = vbNo Then Exit Sub
Application.ScreenUpdating = False
hamsi = Time
ts = ActiveWorkbook.Name
kaplan = ActiveSheet.Name
bordo = ThisWorkbook.Path & "\"
mavi = "Örnek Formüllü Dosya.xlsx"
Workbooks.Open (bordo & mavi)
asi = ActiveSheet.Name
For trabzonspor = 1 To 100
Workbooks(ts).Sheets(kaplan).Rows(trabzonspor).Value = _
Workbooks(mavi).Sheets(asi).Rows(trabzonspor).Value
Next
Application.DisplayAlerts = False
Workbooks(mavi).Close
Application.DisplayAlerts = True
Application.ScreenUpdating = True
MsgBox Format(hamsi - Time, "hh:mm:ss") & vbLf _
& "Sürede Kopyalama Tamamlandı", , "Bitiş"
End Sub

Bu kodu kopyalayın ve deneyin. Tabi kayıt yaparken makro içerebilen dosya şeklinde kayıt yapın.

 

[levoni]

İhsan Bey,
biraz önce deneme şansım oldu elinize sağlık çok güzel olmuş.
Sadece şöyle bir konu var kopyalama işlemini yaptıktan sonra IW sütünundan XFD sütununa kadar bütün hücrelerde #NA yazıyor.Bu da dosyanın boyutunu 5MB yakın bir size ulaştırıyor.Bu konuda bir şey yapılabilirmi eğer sizi uğraştıracaksa hiç zahmet etmeyin.Ben bir şekilde hallederim.
İyi akşamlar

 

[İhsan Tank]

İhsan Bey,
biraz önce deneme şansım oldu elinize sağlık çok güzel olmuş.
Sadece şöyle bir konu var kopyalama işlemini yaptıktan sonra IW sütünundan XFD sütununa kadar bütün hücrelerde #NA yazıyor.Bu da dosyanın boyutunu 5MB yakın bir size ulaştırıyor.Bu konuda bir şey yapılabilirmi eğer sizi uğraştıracaksa hiç zahmet etmeyin.Ben bir şekilde hallederim.
İyi akşamlar

Merhaba
Bu kodu dener misiniz_?

Option Explicit
Sub kopya_61()
Dim ts, kaplan, trabzonspor, hamsi As Date
Dim bordo, mavi, asi, kral
trabzonspor = MsgBox("Verileri Kopyalıyorum", vbYesNo, "Onay")
If trabzonspor = vbNo Then Exit Sub
Application.ScreenUpdating = False
Application.DisplayAlerts = False
hamsi = Time
ts = ActiveWorkbook.Name
kaplan = ActiveSheet.Name
kral = ActiveCell.Address
bordo = ThisWorkbook.Path & "\"
mavi = "Örnek Formüllü Dosya.xlsx"
Workbooks.Open (bordo & mavi)
asi = ActiveSheet.Name
Workbooks(mavi).Sheets(asi).Cells.Copy _
Destination:=Workbooks(ts).Sheets(kaplan).Range("A1")
Application.DisplayAlerts = False
Workbooks(mavi).Close
Application.DisplayAlerts = True
Sheets(kaplan).Cells.Copy
Cells.PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False
Sheets(kaplan).Range(kral).Select
Application.ScreenUpdating = True
MsgBox Format(hamsi - Time, "hh:mm:ss") & vbLf _
& "Sürede Kopyalama Tamamlandı", , "Bitiş"
End Sub

 

[levoni]

İhsan Bey günaydın,
Çok tşk ler ellerinize aklınıza sağlık.Gayet güzel olmuş

 

[İhsan Tank]

İhsan Bey günaydın,
Çok tşk ler ellerinize aklınıza sağlık.Gayet güzel olmuş

Rica ederim
Not : Lütfen kelimelerimizi kısaltmayalım
:keyif:

 

[levoni]

Tamamdır İhsan Bey bundan sonra dikkat ederim
Kolay gelsin

 

[İhsan Tank]

Tamamdır İhsan Bey bundan sonra dikkat ederim
Kolay gelsin

Teşekkür ederim.