sayfayı birebir kopyalama düğmesi

ismail-34

Altın Üye
Katılım
9 Ekim 2021
Mesajlar
157
Excel Vers. ve Dili
excell 2013
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

Moderatör
Yönetici
Katılım
4 Haziran 2005
Mesajlar
14,260
Excel Vers. ve Dili
Ofis 365 Türkçe
Merhaba,
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

Moderatör
Yönetici
Katılım
15 Mart 2005
Mesajlar
37,622
Excel Vers. ve Dili
Microsoft 365 Tr-En 64 Bit
Ofis 2016 Tr-En 32 Bit
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

Altın Üye
Katılım
9 Ekim 2021
Mesajlar
157
Excel Vers. ve Dili
excell 2013
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.
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

Moderatör
Yönetici
Katılım
15 Mart 2005
Mesajlar
37,622
Excel Vers. ve Dili
Microsoft 365 Tr-En 64 Bit
Ofis 2016 Tr-En 32 Bit
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

Altın Üye
Katılım
9 Ekim 2021
Mesajlar
157
Excel Vers. ve Dili
excell 2013
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

Altın Üye
Katılım
9 Ekim 2021
Mesajlar
157
Excel Vers. ve Dili
excell 2013
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

Moderatör
Yönetici
Katılım
15 Mart 2005
Mesajlar
37,622
Excel Vers. ve Dili
Microsoft 365 Tr-En 64 Bit
Ofis 2016 Tr-En 32 Bit
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

Altın Üye
Katılım
9 Ekim 2021
Mesajlar
157
Excel Vers. ve Dili
excell 2013
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

Altın Üye
Katılım
9 Ekim 2021
Mesajlar
157
Excel Vers. ve Dili
excell 2013
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

Moderatör
Yönetici
Katılım
15 Mart 2005
Mesajlar
37,622
Excel Vers. ve Dili
Microsoft 365 Tr-En 64 Bit
Ofis 2016 Tr-En 32 Bit
Resimli örnek bir dosya paylaşın deneme yapalım.
 

Korhan Ayhan

Moderatör
Yönetici
Katılım
15 Mart 2005
Mesajlar
37,622
Excel Vers. ve Dili
Microsoft 365 Tr-En 64 Bit
Ofis 2016 Tr-En 32 Bit
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

Altın Üye
Katılım
9 Ekim 2021
Mesajlar
157
Excel Vers. ve Dili
excell 2013
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 :)
 
Son düzenleme:

Korhan Ayhan

Moderatör
Yönetici
Katılım
15 Mart 2005
Mesajlar
37,622
Excel Vers. ve Dili
Microsoft 365 Tr-En 64 Bit
Ofis 2016 Tr-En 32 Bit
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

Altın Üye
Katılım
9 Ekim 2021
Mesajlar
157
Excel Vers. ve Dili
excell 2013
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

Moderatör
Yönetici
Katılım
15 Mart 2005
Mesajlar
37,622
Excel Vers. ve Dili
Microsoft 365 Tr-En 64 Bit
Ofis 2016 Tr-En 32 Bit
Kod satırını yanlış yere uygulamışsınız.

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

.Range("A1").Select
 

ismail-34

Altın Üye
Katılım
9 Ekim 2021
Mesajlar
157
Excel Vers. ve Dili
excell 2013
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 :)
 
Üst