Yazdırma alnını farklı bir excel kitabına kaydet

[CILEKESH]

Merhaba,
Şu kod ile Yazdırma alanını Yazıcıya gönderiyorum.

Private Sub CommandButton33_Click()
Sheets("Yazdir").Select
Range("a3:m4999").Select
Selection.ClearContents
Sheets("Yazdir").Range("a3:f998").Value = Sheets("Giderler").Range("a3:f998").Value
Sheets("Yazdir").Range("h3:m4999").Value = Sheets("Gelirler").Range("a3:f4999").Value
Application.Visible = True
Sheets("Yazdir").Select
Me.Hide

ActiveSheet.PageSetup.PrintArea = "ALAN"
ActiveWindow.SelectedSheets.PrintPreview
Application.Visible = False
UserForm3.Show
End Sub

Bu kodu Printer dan yazdırmak yerine Farklı bir Excel sayfasına nasıl kaydettirebilirim?

Sadece belirlenen Yadırma alanı Yeni kaydedilen excel sayfasına aktarılacak ve yeni oluşan bu sayfa açılmayacak. Sadece Hedef gösterilen yere kayıt olsun istiyorum.

Mümkün müdür?

 

[CILEKESH]

Üstatlar konu günceldir

 

[halit3]

Bu kod seçtiğiniz alanı başka bir dosyaya A1 den başlıyarak kopyalayıp ana dosyanın yanına kayıt yapıyor.

kod:

Sub sectigim_alanı_kayitet()
adres = ActiveWindow.RangeSelection.Address
If InStr(Trim(adres), ":") = 0 Then: MsgBox "Hiç alan seçmediniz": Exit Sub
Application.ScreenUpdating = False
Application.EnableEvents = False
Dim FileFormatNum As Long
Klasor = ThisWorkbook.Path
If Right(Klasor, 1) <> "\" Then Klasor = Klasor & "\"
Dosya_adi = ActiveWorkbook.Name
Sayfa_Adı = ActiveSheet.Name

Set fLk = CreateObject("Scripting.FileSystemObject")
uzanti = fLk.GetExtensionName(Dosya_adi) ' uzantı buluyor
Dosya = fLk.GetBaseName(Dosya_adi) ' klasörün kendisi
If uzanti = "xls" Then
FileFormatNum = -4143
ElseIf uzanti = "xlsx" Then
FileFormatNum = 51
ElseIf uzanti = "xlsm" Then
FileFormatNum = 52
ElseIf uzanti = "xlsb" Then
FileFormatNum = 50
ElseIf uzanti = "xls" Then
FileFormatNum = 56
End If

adres = ActiveWindow.RangeSelection.Address
If InStr(Trim(adres), ":") = 0 Then Exit Sub
ThisWorkbook.Sheets(ActiveSheet.Name).Range(adres).Copy
Workbooks.Add
Range("A1").Select
ActiveSheet.Paste
Application.CutCopyMode = False
yer = Klasor & Format(Now, "dd-mmm-yy h-mm-ss")
'yer = Klasor & Dosya_adi
If CreateObject("Scripting.FileSystemObject").FileExists(yer) = True Then
MsgBox " Bu isimde bir dosya var"
Application.DisplayAlerts = False
ActiveWindow.Close
Else
ActiveWorkbook.SaveAs yer, FileFormat:=FileFormatNum
ActiveWorkbook.Close SaveChanges:=False
MsgBox yer & " Dosya kayıt edildi"
End If
Application.ScreenUpdating = True
Application.EnableEvents = True
End Sub

 

[istanbulcahan]

Üstadım, bende bu formülden faydalanacağım, baka bir şey düşünüyorum.
Range("A1").Select burda A1 i G1 seçersem kopyalama G1 den başlayacak değil mi, formülde tek değişiklik gerektiren yer burası tam incelemedim ama.

 

[halit3]

Üstadım, bende bu formülden faydalanacağım, baka bir şey düşünüyorum.
Range("A1").Select burda A1 i G1 seçersem kopyalama G1 den başlayacak değil mi, formülde tek değişiklik gerektiren yer burası tam incelemedim ama.

Burada kopyalama seçilen alandan başlıyor yani mause ile nereyi seçerseniz o alanı kopyalıyor ve yeni açılan sayfaya A1 den başlıyarak yapıştırıyor.

 

[istanbulcahan]

Üstadım, a sheeti varsayalım. Burada 1 den fazla yazdııma alanı olarak bunları ayrı ayrı seçebiliyormuyuz.