sayfayı birebir kopyalama düğmesi

ismail-34 · 23 Aralık 2022

Excel web ailesine saygılar sevgiler.

bir sekmeden diğer bir sekmeye birebir kopyalama düğmesi çok işime yarardı .hatta olabiliyorsa yeni bir excel sayfası açıp onun içine kopyalasın ama sadece değerleri kopyalasın istiyorum.kopyaladığım sayfadaki formüller gitmemeli.

eğer olmuyorsa sekmeye sadece değerleri kopyalamalı.

böyle bişi olursa devamlı bir sayfadan yeni bir sayfaya veri taşımam kolaylaşmış olcak..çünkü veri çekdiğim sayfayı başkasına göndermek istiyorum sadece içinde bazı tabları formülsüz şekilde göndermek istiyorum

şimdiden çok teşekkürler.

Necdet · 23 Aralık 2022

Merhaba,

ismail-34' Alıntı:
sadece değerleri kopyalasın istiyorum.kopyaladığım sayfadaki formüller gitmemeli.

Sadece değerler kopyalasın diyorsanız formüller gider.
Siz bence altın üyesiniz örnek bir dosya ekleyin.
Hangi sayfa kopyalanacak ve yeni sayfanın adı ne olacak, olmalı? onu belirtin.

Korhan Ayhan · 23 Aralık 2022

Aşağıdaki kodu kullanarak seçtiğiniz (aktif) sayfayı yeni bir excel kitabına kopyalayarak çoğaltabilirsiniz.

Sayfanızda koruma olabileceğini düşünerek ilgili satırları koda ekledim. Koruma kullanmıyorsanız ilgili satırları silebilirsiniz ya da pasif hale getirebilirsiniz.

C++:

Option Explicit

Sub Sheets_Copy()
    Dim Sh As Worksheet
 
    Set Sh = ActiveSheet
 
    Application.ScreenUpdating = 0
    Application.Calculation = -4135
    Application.EnableEvents = 0
 
    With Sh
        .Unprotect "12345"
        .Copy
        .Protect "12345"
    End With
 
    Set Sh = ActiveSheet
 
    With Sh
        .Cells.Copy
        .Cells.PasteSpecial xlPasteValues
        .Range("A1").Select
        On Error Resume Next
        .DrawingObjects.Delete
        On Error GoTo 0
    End With

    Application.CutCopyMode = 0
    Application.EnableEvents = 1
    Application.Calculation = -4105
    Application.ScreenUpdating = 1
    
    Application.DisplayAlerts = False
    ActiveWorkbook.SaveAs Filename:=VBA.CreateObject("WScript.Shell").SpecialFolders("Desktop") & _
                          "\Rapor.xlsx", FileFormat:=51, Local:=True
    ActiveWorkbook.Close 0
    Application.DisplayAlerts = True
    
    MsgBox "Aktif sayfanın kopyası masaüstüne Rapor.xlsx adıyla kayıt edilmiştir.", vbInformation
End Sub

ismail-34 · 24 Aralık 2022

Necdet' Alıntı:
Merhaba,

Sadece değerler kopyalasın diyorsanız formüller gider.
Siz bence altın üyesiniz örnek bir dosya ekleyin.
Hangi sayfa kopyalanacak ve yeni sayfanın adı ne olacak, olmalı? onu belirtin.

formüller yeni sayfaya gitmesin-kopyalanmasın anlamında söyledim hocam.yani formüller gitsin istemiyorum.yeni sayfanın adı "sekmeden kurtarılan sayfa" olabilir.kopyalanan sekmenin (kaynak) adıda sekme1 olsun.

Korhan Ayhan' Alıntı:
Option Explicit Sub Sheets_Copy() Dim Sh As Worksheet Set Sh = ActiveSheet Application.ScreenUpdating = 0 Application.Calculation = -4135 Application.EnableEvents = 0 With Sh .Unprotect "12345" .Copy .Protect "12345" End With Set Sh = ActiveSheet With Sh .Cells.Copy .Cells.PasteSpecial xlPasteValues .Range("A1").Select End With Application.CutCopyMode = 0 Application.EnableEvents = 1 Application.Calculation = -4105 Application.ScreenUpdating = 1 End Sub

hocam teşekkürler.güzel çalışıyor ama formüller, makrolar , düğmeler kopyalanmasın istiyorum mümkünmü ?.. sadece veriler ve biçimler yani.

Korhan Ayhan · 25 Aralık 2022

Sayfadaki butonları silecek kod satırını ve dosyayı makrosuz masaüstüne Rapor.xlsx adıyla kaydetme özelliğini önerdiğim koda ekledim. Son halini deneyebilirsiniz.

ismail-34 · 25 Aralık 2022

Korhan Ayhan' Alıntı:
Sayfadaki butonları silecek kod satırını ve dosyayı makrosuz masaüstüne Rapor.xlsx adıyla kaydetme özelliğini önerdiğim koda ekledim. Son halini deneyebilirsiniz.

tam istediğim gibi.3.şahıslara rapor gönderimi için tam bir sanat eseri. çok faydalı oldu.sağolun varolun çok değerli korhan hocam.

ismail-34 · 26 Aralık 2022

Korhan Ayhan' Alıntı:

Aşağıdaki kodu kullanarak seçtiğiniz (aktif) sayfayı yeni bir excel kitabına kopyalayarak çoğaltabilirsiniz.

Sayfanızda koruma olabileceğini düşünerek ilgili satırları koda ekledim. Koruma kullanmıyorsanız ilgili satırları silebilirsiniz ya da pasif hale getirebilirsiniz.

C++:

Option Explicit

Sub Sheets_Copy()
    Dim Sh As Worksheet

    Set Sh = ActiveSheet

    Application.ScreenUpdating = 0
    Application.Calculation = -4135
    Application.EnableEvents = 0

    With Sh
        .Unprotect "12345"
        .Copy
        .Protect "12345"
    End With

    Set Sh = ActiveSheet

    With Sh
        .Cells.Copy
        .Cells.PasteSpecial xlPasteValues
        .Range("A1").Select
        On Error Resume Next
        .DrawingObjects.Delete
        On Error GoTo 0
    End With

    Application.CutCopyMode = 0
    Application.EnableEvents = 1
    Application.Calculation = -4105
    Application.ScreenUpdating = 1
   
    Application.DisplayAlerts = False
    ActiveWorkbook.SaveAs Filename:=VBA.CreateObject("WScript.Shell").SpecialFolders("Desktop") & _
                          "\Rapor.xlsx", FileFormat:=51, Local:=True
    ActiveWorkbook.Close 0
    Application.DisplayAlerts = True
   
    MsgBox "Aktif sayfanın kopyası masaüstüne Rapor.xlsx adıyla kayıt edilmiştir.", vbInformation
End Sub

hocam son bişi sorcam dosya adı olarak sekmenin adını alabiliyormu ?

Korhan Ayhan · 26 Aralık 2022

Alabilir...

C++:

Option Explicit

Sub Sheets_Copy()
    Dim Sh As Worksheet, File_Name As String
 
    Set Sh = ActiveSheet
    File_Name = Sh.Name & ".xlsx"
 
    Application.ScreenUpdating = 0
    Application.Calculation = -4135
    Application.EnableEvents = 0
 
    With Sh
        .Unprotect "12345"
        .Copy
        .Protect "12345"
    End With
 
    Set Sh = ActiveSheet
 
    With Sh
        .Cells.Copy
        .Cells.PasteSpecial xlPasteValues
        .Range("A1").Select
        On Error Resume Next
        .DrawingObjects.Delete
        On Error GoTo 0
    End With

    Application.CutCopyMode = 0
    Application.EnableEvents = 1
    Application.Calculation = -4105
    Application.ScreenUpdating = 1
    
    Application.DisplayAlerts = False
    ActiveWorkbook.SaveAs Filename:=VBA.CreateObject("WScript.Shell").SpecialFolders("Desktop") & "\" & File_Name, FileFormat:=51, Local:=True
    ActiveWorkbook.Close 0
    Application.DisplayAlerts = True
    
    MsgBox "Aktif sayfanın kopyası masaüstüne Rapor.xlsx adıyla kayıt edilmiştir.", vbInformation
End Sub

ismail-34 · 26 Aralık 2022

Korhan Ayhan' Alıntı:

Alabilir...

C++:

Option Explicit

Sub Sheets_Copy()
    Dim Sh As Worksheet, File_Name As String

    Set Sh = ActiveSheet
    File_Name = Sh.Name & ".xlsx"

    Application.ScreenUpdating = 0
    Application.Calculation = -4135
    Application.EnableEvents = 0

    With Sh
        .Unprotect "12345"
        .Copy
        .Protect "12345"
    End With

    Set Sh = ActiveSheet

    With Sh
        .Cells.Copy
        .Cells.PasteSpecial xlPasteValues
        .Range("A1").Select
        On Error Resume Next
        .DrawingObjects.Delete
        On Error GoTo 0
    End With

    Application.CutCopyMode = 0
    Application.EnableEvents = 1
    Application.Calculation = -4105
    Application.ScreenUpdating = 1
   
    Application.DisplayAlerts = False
    ActiveWorkbook.SaveAs Filename:=VBA.CreateObject("WScript.Shell").SpecialFolders("Desktop") & "\" & File_Name, FileFormat:=51, Local:=True
    ActiveWorkbook.Close 0
    Application.DisplayAlerts = True
   
    MsgBox "Aktif sayfanın kopyası masaüstüne Rapor.xlsx adıyla kayıt edilmiştir.", vbInformation
End Sub

Eyw hocam dosya ismindende kurtulduk

İyi çalışmalar Dilerim. sağolun Varolun.

ismail-34 · 23 Ocak 2023

Korhan Ayhan' Alıntı:

Alabilir...

C++:

Option Explicit

Sub Sheets_Copy()
    Dim Sh As Worksheet, File_Name As String

    Set Sh = ActiveSheet
    File_Name = Sh.Name & ".xlsx"

    Application.ScreenUpdating = 0
    Application.Calculation = -4135
    Application.EnableEvents = 0

    With Sh
        .Unprotect "12345"
        .Copy
        .Protect "12345"
    End With

    Set Sh = ActiveSheet

    With Sh
        .Cells.Copy
        .Cells.PasteSpecial xlPasteValues
        .Range("A1").Select
        On Error Resume Next
        .DrawingObjects.Delete
        On Error GoTo 0
    End With

    Application.CutCopyMode = 0
    Application.EnableEvents = 1
    Application.Calculation = -4105
    Application.ScreenUpdating = 1
   
    Application.DisplayAlerts = False
    ActiveWorkbook.SaveAs Filename:=VBA.CreateObject("WScript.Shell").SpecialFolders("Desktop") & "\" & File_Name, FileFormat:=51, Local:=True
    ActiveWorkbook.Close 0
    Application.DisplayAlerts = True
   
    MsgBox "Aktif sayfanın kopyası masaüstüne Rapor.xlsx adıyla kayıt edilmiştir.", vbInformation
End Sub

Hocam affınıza sığınarak bir şeyi merak ettim .Sayfa içinde resim varsa onu kaydetmiyor.

resimler formüllerle bir tutuluyor diyemi kaydetmiyor acaba ? eğer resimler içinde bir ekleme yapabiliyorsak güzel olurdu.misal ben en üste antetli kağıdın resmini koymayı istiyorum

Korhan Ayhan · 23 Ocak 2023

Resimli örnek bir dosya paylaşın deneme yapalım.

ismail-34 · 23 Ocak 2023

örnek ekteki diyelim hocam.

Korhan Ayhan · 24 Ocak 2023

Deneyiniz.

C++:

Option Explicit

Sub Sheets_Copy()
    Dim Sh As Worksheet, File_Name As String
 
    Set Sh = ActiveSheet
    File_Name = Sh.Name & ".xlsx"
 
    Application.ScreenUpdating = 0
    Application.Calculation = -4135
    Application.EnableEvents = 0
 
    With Sh
        .Unprotect "12345"
        .Copy
        .Protect "12345"
    End With
 
    Set Sh = ActiveSheet
 
    With Sh
        .Cells.Copy
        .Cells.PasteSpecial xlPasteValues
        .Range("A1").Select
    End With

    Application.CutCopyMode = 0
    Application.EnableEvents = 1
    Application.Calculation = -4105
    Application.ScreenUpdating = 1
    
    Application.DisplayAlerts = False
    ActiveWorkbook.SaveAs Filename:=VBA.CreateObject("WScript.Shell").SpecialFolders("Desktop") & "\" & File_Name, FileFormat:=51, Local:=True
    ActiveWorkbook.Close 0
    Application.DisplayAlerts = True
    
    MsgBox "Aktif sayfanın kopyası masaüstüne Rapor.xlsx adıyla kayıt edilmiştir.", vbInformation
End Sub

ismail-34 · 24 Ocak 2023

Hocam elinize sağlık çok güzel çalışıyor..makro butonunuda (dikdörtgen çizim) kaydederken yok etse rapor çıktısı çok daha güzel olurdu

heralde onuda resim gibi algılıyor excell değilmi ? o yüzden resimsiz sayfalar için evvelki makro butonunuda silen resimsiz versiyonunuda elimin altında bulunduruyorum

Korhan Ayhan · 24 Ocak 2023

Ben İngilizce sürüm kullanıyorum. Sayfaya bir şekil çizip makro kaydet ile sildim aşağıdaki kod oluştu. Sizde aynı yöntemi deneyip oluşan kod satırını önerdiğim kodun içine entegre edebilirsiniz.

ActiveSheet.Shapes.Range(Array("Rectangle 1")).Delete

ismail-34 · 25 Ocak 2023

Değerli hocam bu seferde sadece orjinalindeki şekli siliyor rapordaki şekil ise duruyor.

Sub sayfayi_masaustune_kaydet_resimli()
Dim Sh As Worksheet, File_Name As String

Set Sh = ActiveSheet
File_Name = Sh.Name & ".xlsx"

Application.ScreenUpdating = 0
Application.Calculation = -4135
Application.EnableEvents = 0
ActiveSheet.Shapes.Range(Array("Dikdörtgen 2")).Delete

With Sh
.Copy

End With

Set Sh = ActiveSheet

With Sh
.Cells.Copy
.Cells.PasteSpecial xlPasteValues
.Range("A1").Select
End With

Application.CutCopyMode = 0
Application.EnableEvents = 1
Application.Calculation = -4105
Application.ScreenUpdating = 1

Application.DisplayAlerts = False
ActiveWorkbook.SaveAs Filename:=VBA.CreateObject("WScript.Shell").SpecialFolders("Desktop") & "\" & File_Name, FileFormat:=51, Local:=True
ActiveWorkbook.Close 0
Application.DisplayAlerts = True

MsgBox "Aktif sayfanın kopyası masaüstüne Rapor.xlsx adıyla kayıt edilmiştir.", vbInformation
End Sub

Korhan Ayhan · 25 Ocak 2023

Kod satırını yanlış yere uygulamışsınız.

Şu satırın üstüne uygulayıp deneyiniz.

.Range("A1").Select

ismail-34 · 26 Ocak 2023

Korhan Ayhan' Alıntı:
Kod satırını yanlış yere uygulamışsınız.

Şu satırın üstüne uygulayıp deneyiniz.

.Range("A1").Select

Haklısınız Değerli hocam şu an süper çalışıyor.hem resimli hem resimsiz versiyonu güzel oldu.elinize sağlık sağlıcakla kalın raporların efendisi hocam

sayfayı birebir kopyalama düğmesi

ismail-34

Necdet

Moderatör

Korhan Ayhan

Administrator

ismail-34

Korhan Ayhan

Administrator

ismail-34

ismail-34

Korhan Ayhan

Administrator

ismail-34

ismail-34

Korhan Ayhan

Administrator

ismail-34

Ekli dosyalar

Korhan Ayhan

Administrator

ismail-34

Korhan Ayhan

Administrator

ismail-34

Korhan Ayhan

Administrator

ismail-34