Excel Sayfa Kopyalama

Katılım
1 Ağustos 2020
Mesajlar
11
Excel Vers. ve Dili
2020 TR
Herkese hayırlı bayramlar. Arkadaşlar ekte gördüğünüz tablonun aynısını bir buton ile yeni çalışma sayfasına aktarmak istiyorum. Butonu ekledim kodlar şu şekilde.

Kod:
Sub buton()
Dim sh As Worksheet
Set sh = ActiveSheet
Worksheets.Add after:=Sheets(Sheets.Count)
ActiveSheet.Name = "Sayfa" & Sheets.Count
sh.Cells.Copy
Range("A1").PasteSpecial xlPasteValuesAndNumberFormats
Application.CutCopyMode = False
Range("A1").Select
MsgBox "Sayfa eklendi ve kopyalama yapıldı."
End Sub
Kopyalama çalışıyor fakat biçimlendirmeyi aktarmıyor. Bu konuda yardımcı olur musunuz?
 

İdris SERDAR

Moderatör
Yönetici
Katılım
21 Ekim 2005
Mesajlar
16,090
Excel Vers. ve Dili
Excel, 2016 - İngilizce
.

Deneyin.

Kod:
Sub buton()

Dim sh As Worksheet
Set sh = ActiveSheet

Worksheets.Add after:=Sheets(Sheets.Count)
ActiveSheet.Name = "Sayfa" & Sheets.Count

sh.Cells.Copy

Range("A1").PasteSpecial Paste:=xlPasteValuesAndNumberFormats
Range("A1").PasteSpecial Paste:=xlPasteFormats
Range("A1").PasteSpecial Paste:=xlPasteColumnWidths

Application.CutCopyMode = False
Range("A1").Select
MsgBox "Sayfa eklendi ve kopyalama yapıldı."

End Sub
.
 
Katılım
1 Ağustos 2020
Mesajlar
11
Excel Vers. ve Dili
2020 TR
.

Deneyin.

Kod:
Sub buton()

Dim sh As Worksheet
Set sh = ActiveSheet

Worksheets.Add after:=Sheets(Sheets.Count)
ActiveSheet.Name = "Sayfa" & Sheets.Count

sh.Cells.Copy

Range("A1").PasteSpecial Paste:=xlPasteValuesAndNumberFormats
Range("A1").PasteSpecial Paste:=xlPasteFormats
Range("A1").PasteSpecial Paste:=xlPasteColumnWidths

Application.CutCopyMode = False
Range("A1").Select
MsgBox "Sayfa eklendi ve kopyalama yapıldı."

End Sub
https://hizliresim.com/cP0vUk aslı bu
https://hizliresim.com/AzFnIq ama kopyalarıca böyle oluyor.
 

İdris SERDAR

Moderatör
Yönetici
Katılım
21 Ekim 2005
Mesajlar
16,090
Excel Vers. ve Dili
Excel, 2016 - İngilizce
.

Dosya yükleme sitelerinden birine örnek dosya eklerseniz, deneme olanağım olabilir.

.
 

cicosz

Altın Üye
Katılım
30 Mart 2010
Mesajlar
180
Excel Vers. ve Dili
2007,2010,2013
Merhaba,
Aşağıdaki şekliyle dener misiniz?
Kod:
Sub buton()

Dim sh As Worksheet
Set sh = ActiveSheet

Application.ScreenUpdating = False

sh.Copy after:=Sheets(Sheets.Count)
ActiveSheet.Name = "Sayfa" & Sheets.Count
ActiveSheet.Range("A1").Select

Application.ScreenUpdating = True

MsgBox "Sayfa eklendi ve kopyalama yapıldı."

End Sub
 
Katılım
1 Ağustos 2020
Mesajlar
11
Excel Vers. ve Dili
2020 TR
Merhaba,
Aşağıdaki şekliyle dener misiniz?
Kod:
Sub buton()

Dim sh As Worksheet
Set sh = ActiveSheet

Application.ScreenUpdating = False

sh.Copy after:=Sheets(Sheets.Count)
ActiveSheet.Name = "Sayfa" & Sheets.Count
ActiveSheet.Range("A1").Select

Application.ScreenUpdating = True

MsgBox "Sayfa eklendi ve kopyalama yapıldı."

End Sub
Teşekkürler çözüm oldu. Bir istirhamım daha olabilir mi acaba ?
Fotoğraf ta gördüğünüz üzere sayfa eklendikten sonra sayfa adını eklendiği günün tarihini yazdırabilir miyiz ?
 
Katılım
1 Ağustos 2020
Mesajlar
11
Excel Vers. ve Dili
2020 TR
Kod:
Sub buton()

Dim sh As Worksheet
Set sh = ActiveSheet

Application.ScreenUpdating = False

sh.Copy after:=Sheets(Sheets.Count)
ActiveSheet.Name = "date" & Sheets.Count
ActiveSheet.Range("A1").Select
Application.ScreenUpdating = True

    Dim Tarih   As Date
    Dim Sayfa   As Worksheet
    Dim Durum   As Boolean
    Dim indis   As Integer
    
    For Each Sayfa In Worksheets
        If IsDate(Sayfa.Name) = True Then
            If Sayfa.Name > Tarih Then
                Tarih = Sayfa.Name
                indis = Sayfa.Index
            End If
        End If
    Next Sayfa
    
    If Tarih = "00:00:00" Then
        Tarih = Date
    Else
        Durum = True
        Tarih = Tarih
    End If
    
    ActiveSheet.Name = Format(Tarih + 1, "dd.mm.yy")
    If Durum = True Then
        Sheets(indis).Cells.Copy
        Range("A1").Select
        ActiveSheet.Paste
        Range("A1").Select
    Else
        MsgBox "Tarih Yok", vbCritical
    End If
    
End Sub
Bu şekilde çözdüm @cicosz sadece içerde görünen tarihi yapamadım insallah bulurum onuda :)
 

cicosz

Altın Üye
Katılım
30 Mart 2010
Mesajlar
180
Excel Vers. ve Dili
2007,2010,2013
Merhaba,

Bu şekilde dener misiniz?
Kod:
Sub buton()

Dim sh, sht As Worksheet, tarih As Variant
tarih = Format(Date, "dd.mm.yyyy")
Set sh = ActiveSheet
Application.ScreenUpdating = False


For Each sht In Worksheets
    If sht.Name = tarih Then
        MsgBox "Bu sayfayı daha önce eklemişsiniz."
        Exit Sub
     End If
Next sht

sh.Copy after:=Sheets(Sheets.Count)
ActiveSheet.Name = tarih
ActiveSheet.Range("A1").Select
Selection.Value = tarih
MsgBox "Sayfa eklendi ve kopyalama yapıldı."
Application.ScreenUpdating = True

End Sub
 
Katılım
1 Ağustos 2020
Mesajlar
11
Excel Vers. ve Dili
2020 TR
Merhaba,

Bu şekilde dener misiniz?
Kod:
Sub buton()

Dim sh, sht As Worksheet, tarih As Variant
tarih = Format(Date, "dd.mm.yyyy")
Set sh = ActiveSheet
Application.ScreenUpdating = False


For Each sht In Worksheets
    If sht.Name = tarih Then
        MsgBox "Bu sayfayı daha önce eklemişsiniz."
        Exit Sub
     End If
Next sht

sh.Copy after:=Sheets(Sheets.Count)
ActiveSheet.Name = tarih
ActiveSheet.Range("A1").Select
Selection.Value = tarih
MsgBox "Sayfa eklendi ve kopyalama yapıldı."
Application.ScreenUpdating = True

End Sub
https://we.tl/t-bqwChcCtkk dosya burada png dosyasında açıklama mevcut şimdiden çok teşekkür ederim.
 

cicosz

Altın Üye
Katılım
30 Mart 2010
Mesajlar
180
Excel Vers. ve Dili
2007,2010,2013
Merhaba,
Bugünün sayfa oluştururken içerisinde bulunulan tarih referans alınmıştır. Siz sayfa ekle dedikçe gün artsın mı istiyorsunuz yoksa sadece içerisinde bulunulan güne ait sayfa oluştursun mu istiyorsunuz? Kısacası sayfa ekle dedikçe bir önceki tarihin üzerine 1 ekleyerek yeni sayfayı mı oluştursun?

 
Son düzenleme:

cicosz

Altın Üye
Katılım
30 Mart 2010
Mesajlar
180
Excel Vers. ve Dili
2007,2010,2013
Merhaba,

Yazdığınız şekliyle olur. Alternatif olarak MsgBox satırının üst satırına eklediğim kod ile tek satırda da halledebilirsiniz.
Kod:
Sub buton()

Dim sh, sht As Worksheet, tarih As Date
Set sh = ActiveSheet
Application.ScreenUpdating = False
tarih = Sheets(Sheets.Count).Range("A1").Value + 1
sh.Copy after:=Sheets(Sheets.Count)
ActiveSheet.Name = tarih
ActiveSheet.Range("A1").Select
Selection.Value = tarih

ActiveSheet.Range("A5:C100").ClearContents

MsgBox "Sayfa eklendi ve kopyalama yapıldı."
Application.ScreenUpdating = True

End Sub
 
Katılım
1 Ağustos 2020
Mesajlar
11
Excel Vers. ve Dili
2020 TR
Merhaba,

Yazdığınız şekliyle olur. Alternatif olarak MsgBox satırının üst satırına eklediğim kod ile tek satırda da halledebilirsiniz.
Kod:
Sub buton()

Dim sh, sht As Worksheet, tarih As Date
Set sh = ActiveSheet
Application.ScreenUpdating = False
tarih = Sheets(Sheets.Count).Range("A1").Value + 1
sh.Copy after:=Sheets(Sheets.Count)
ActiveSheet.Name = tarih
ActiveSheet.Range("A1").Select
Selection.Value = tarih

ActiveSheet.Range("A5:C100").ClearContents

MsgBox "Sayfa eklendi ve kopyalama yapıldı."
Application.ScreenUpdating = True

End Sub
Teşekkürler peki bu textbox nasıl temizleyebilirim ? Kusura bakmayın çok soru sordum hakkınızı helal edin.
 

cicosz

Altın Üye
Katılım
30 Mart 2010
Mesajlar
180
Excel Vers. ve Dili
2007,2010,2013
Merhaba,

Dosyanızın yedeğini alarak buton fonksiyonuna
Kod:
ActiveSheet.Shapes(2).TextFrame.Characters.Text = ""
kodunu ekleyerek dener misiniz?
Sizin dosyanızda 1. şekil "Sayfa Ekle" butonu olduğu için "Metin Kutusu"nu 2. şekil olarak kabul ettim.

Kod:
Sub buton()

Dim sh, sht As Worksheet, tarih As Date
Set sh = ActiveSheet
Application.ScreenUpdating = False
tarih = Sheets(Sheets.Count).Range("A1").Value + 1
sh.Copy after:=Sheets(Sheets.Count)
ActiveSheet.Name = tarih
ActiveSheet.Range("A1").Select
Selection.Value = tarih

ActiveSheet.Range("A5:C100").ClearContents
ActiveSheet.Shapes(2).TextFrame.Characters.Text = ""

MsgBox "Sayfa eklendi ve kopyalama yapıldı."
Application.ScreenUpdating = True

End Sub
 
Katılım
1 Ağustos 2020
Mesajlar
11
Excel Vers. ve Dili
2020 TR
Merhaba,

Dosyanızın yedeğini alarak buton fonksiyonuna
Kod:
ActiveSheet.Shapes(2).TextFrame.Characters.Text = ""
kodunu ekleyerek dener misiniz?
Sizin dosyanızda 1. şekil "Sayfa Ekle" butonu olduğu için "Metin Kutusu"nu 2. şekil olarak kabul ettim.

Kod:
Sub buton()

Dim sh, sht As Worksheet, tarih As Date
Set sh = ActiveSheet
Application.ScreenUpdating = False
tarih = Sheets(Sheets.Count).Range("A1").Value + 1
sh.Copy after:=Sheets(Sheets.Count)
ActiveSheet.Name = tarih
ActiveSheet.Range("A1").Select
Selection.Value = tarih

ActiveSheet.Range("A5:C100").ClearContents
ActiveSheet.Shapes(2).TextFrame.Characters.Text = ""

MsgBox "Sayfa eklendi ve kopyalama yapıldı."
Application.ScreenUpdating = True

End Sub
Oldu çok teşekkür ederim. Hakkınızı helal edin.
 
Üst