Kaydet Butonu İle Makro Oluşturma

[TheRainmaker]

Merhaba;
Eklemiş olduğum dosyanın sadece Kimlik Girişi ve Mali Rapor sayfalarının veri içeren satır ve sutunlarını günün tarihine göre belirlediğimiz yola (D:/Yedek) gibi) kaydedilmesi mümkünmüdür?


Yardımlarınız için teşekkürler...

Saygılarımla...

 

[Levent Menteşoğlu]

Aşağıdaki kodu deneyin. Öncelikle D:\yedek isimli bir klasör oluşturun.

Sub yedekle()
Application.ScreenUpdating = False
Sheets(Array("KİMLİK GİRİŞİ", "MALİ RAPOR")).Copy
ActiveWorkbook.SaveAs "D:\yedek\" & Date & ".xls"
Workbooks(Date & ".xls").Activate
Sheets(Array("KİMLİK GİRİŞİ", "MALİ RAPOR")).Select
Cells.Copy
Cells.PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False
Sheets(1).Select
Workbooks(Date & ".xls").Close True
End Sub

 

[TheRainmaker]

Forumda bulduğum aşağıdaki kod düzenlenirse işimi görebilir...
Düzenleme şu şekilde olmalı;
İlgili sayfalardaki sadece veri içeren bölüm alttaki linkler kaydetme dışı .
Ve kaydedilirken o günün tarihi eklenirse tam istediğim gibi olacak...

Private Sub kaydet()
'klasör açılıyor, dosya b8'den adını alıyor, dosya klasöre kaydediliyor,
isim = Range("b8").Value
Fname = isim & ".XLS"
ActiveSheet.Copy
klasor = "frk_klasor"
Set ws = ActiveSheet
Application.DisplayAlerts = False
ac:
Set Fs = CreateObject("Scripting.FileSystemObject")
If Fs.FolderExists("C:\" & klasor) Then
GoTo devam
Else
Fs.CreateFolder ("C:\" & klasor)
GoTo ac
End If
devam:
With ws
.SaveAs "c:\" & klasor & "\" & Fname
End With
Application.DisplayAlerts = True
Application.ScreenUpdating = True
ActiveWorkbook.Close
MsgBox "Kayıt işleminiz tamamlandı. " & vbNewLine & _
"lütfen kontrol ediniz ", vbInformation, "B i l g i "
End Sub

 

[TheRainmaker]

Aşağıdaki kodu deneyin.

Sub yedekle()
Application.ScreenUpdating = False
Sheets(Array("KİMLİK GİRİŞİ", "MALİ RAPOR")).Copy
ActiveWorkbook.SaveAs "D:\yedek\" & Date & ".xls"
Workbooks(Date & ".xls").Activate
Sheets(Array("KİMLİK GİRİŞİ", "MALİ RAPOR")).Select
Cells.Copy
Cells.PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False
Sheets(1).Select
Workbooks(Date & ".xls").Close True
End Sub

Sevgili leventtm;
Üstte vermiş olduğunuz kod işimi gördü...
Dosyada bulunan en alttaki linklerin kayıt dışı olması mümkünmüdür?

Yardınmınız için teşekkürler...

 

[Levent Menteşoğlu]

Dosyada bulunan en alttaki linklerin kayıt dışı olması mümkünmüdür?

linkten kastınız butonlarmıdır.

 

[TheRainmaker]

linkten kastınız butonlarmıdır.

Evet ta kendisi...
Kimlik girişinde A36 dahil
Mali Rapor sayfasınında A41 dahil
altta kalan hiçbirşeyin görünmemesi mümkünmüdür?

 

[Levent Menteşoğlu]

Aşağıdaki kodu deneyin.

Sub yedekle()
Application.ScreenUpdating = False
Sheets(Array("KİMLİK GİRİŞİ", "MALİ RAPOR")).Copy
ActiveWorkbook.SaveAs "D:\yedek\" & Date & ".xls"
Workbooks(Date & ".xls").Activate
Sheets(Array("KİMLİK GİRİŞİ", "MALİ RAPOR")).Select
Cells.Copy
Cells.PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False
Sheets("KİMLİK GİRİŞİ").Rows("36:38").Delete
Sheets("MALİ RAPOR").Rows("41:43").Delete
Sheets(1).Select
Workbooks(Date & ".xls").Close True
End Sub

 

[TheRainmaker]

Çok teşekkür ederim gerçekten harikasınız...
Son sorum şu olacak kimlik girişi ve mali raporun sadece veri olan bölümlerini yazdırmak için gerekli olan kodu verebilirmisiniz?
Yani yazdır butonuna bastığımda yatay bir şekilde veri olan kısımları yazdırabilirmiyiz?
Edit:Yazdırma yedekleme üzerinden değil asıl sayfalardan olacak...

 

[Levent Menteşoğlu]

Kimlik girişi sayfası için,

Sub kimlikyazdir()
say = WorksheetFunction.CountIf(Sheets("kimlik giri&#351;i").[c2:c35], "<>0") + 1
Sheets("kimlik giri&#351;i").PageSetup.PrintArea = "$A$1:$K$" & say
Sheets("kimlik giri&#351;i").printout
End Sub

Mali rapor sayfası için,

Sub maliyazdir()
say = WorksheetFunction.CountIf(Sheets("mali rapor").[c2:c35], "<>0") + 1
Sheets("mali rapor").PageSetup.PrintArea = "$A$1:$R$" & say
Sheets("mali rapor").printout
End Sub

 

[TheRainmaker]

Kimlik girişi sayfası için,

Sub kimlikyazdir()
say = WorksheetFunction.CountIf(Sheets("kimlik girişi").[c2:c35], "<>0") + 1
Sheets("kimlik girişi").PageSetup.PrintArea = "$A$1:$K$" & say
End Sub

Mali rapor sayfası için,

Sub maliyazdir()
say = WorksheetFunction.CountIf(Sheets("mali rapor").[c2:c35], "<>0") + 1
Sheets("mali rapor").PageSetup.PrintArea = "$A$1:$R$" & say
End Sub

Üstteki kodlar varsayılan yazıcıya gönderiyor yanılmıyorsam...
Eğer öyle ise herşey mükemmel...
Yardımlarınız ve ve ayırdığınız zamanınız için çok teşekkür ederim...

Çalışmalarınızın devamını dilerim...

Saygılarımla...

 

[Levent Menteşoğlu]

Kodlar yazıcıya göndermiyor, sadece alanı belirliyordu. Yazdırmayıda yukarıdaki kodlara ilave ettim.

 

[istanbulcahan]

Merhaba;
Eklemiş olduğum dosyanın sadece Kimlik Girişi ve Mali Rapor sayfalarının veri içeren satır ve sutunlarını günün tarihine göre belirlediğimiz yola (D:/Yedek) gibi) kaydedilmesi mümkünmüdür?


Yardımlarınız için teşekkürler...

Saygılarımla...

dosyayı tekraren paylaşırmısınız. o tarihteki dosyalar malum kayıp oldugundan, dosyayı açamıyorum. bana da gerekli.