Makro ile yeni sayfaya kopyalama-yapıştırma

[YUSUF44]

Kod için teşekkür ederim kopyalama yapıyor fakat bu kopyalamada kopyalanan yerin biçmini almıyor sadece yazıları alıyor bire bir aynısını nasıl alabiliriz ?

Şöyle deneyin:

Sub sayfa_ekle_kopyala59()
Dim sh As Worksheet
Set sh = ActiveSheet
Worksheets.Add after:=Sheets(Sheets.Count)
ActiveSheet.Name = "Sayfa" & Sheets.Count
sh.Cells.Copy Range("A1")
Application.CutCopyMode = False
Range("A1").Select
MsgBox "Sayfa eklendi ve kopyalama yapıldı." & vbLf & "evrengizlen@hotmail.com"
End Sub

 

[YUSUF44]

Sub SAYFA_KOPYALA()
    Dim SAYFA_ADI As Variant

    SAYFA_ADI = Application.InputBox("sayfa adı giriniz.")

    If SAYFA_ADI = False Then
    MsgBox "İşleminiz iptal edilmiştir.", vbInformation
    Exit Sub: End If

    If SAYFA_ADI = "" Then
    MsgBox "Lütfen Sayfa adı giriniz. İşleminiz iptal edilmiştir.", vbInformation
    Exit Sub: End If

    Sheets("SABLON").Copy after:=Sheets(Sheets.Count)
 
    On Error Resume Next
    ActiveSheet.Name = SAYFA_ADI
    If Err = 1004 Then
    MsgBox "Aynı isimde sayfa bulunmaktadır. Eklenen son sayfa silinecektir.", vbCritical, "Dikkat !"
    Application.DisplayAlerts = False
    ActiveSheet.Delete
    Application.DisplayAlerts = True

    End If
 
End Sub

Bu kodda benzer sadece Sablon adındaki sayfayı kopyalıyor bana aktif sayfayı kopyalayan kod lazım

Bu da böyle:

Sub SAYFA_KOPYALA()
    Dim SAYFA_ADI As Variant

    SAYFA_ADI = Application.InputBox("sayfa adı giriniz.")

    If SAYFA_ADI = False Then
    MsgBox "İşleminiz iptal edilmiştir.", vbInformation
    Exit Sub: End If

    If SAYFA_ADI = "" Then
    MsgBox "Lütfen Sayfa adı giriniz. İşleminiz iptal edilmiştir.", vbInformation
    Exit Sub: End If

    ActiveSheet.Copy after:=Sheets(Sheets.Count)
 
    On Error Resume Next
    ActiveSheet.Name = SAYFA_ADI
    If Err = 1004 Then
    MsgBox "Aynı isimde sayfa bulunmaktadır. Eklenen son sayfa silinecektir.", vbCritical, "Dikkat !"
    Application.DisplayAlerts = False
    ActiveSheet.Delete
    Application.DisplayAlerts = True
 
    End If
 
End Sub

 

[yusuf1284]

@YUSUF44 ilgi alakanız için çok teşekkür ederim hocam bir de eklenen sayfanın adını sormadan direk o günün tarihini (örn: 05.04.2021) yapma imkanımız var mı?

 

[YUSUF44]

Son makroda aşağıdaki kısmı değiştirip deneyin:

Eski hali:

SAYFA_ADI = Application.InputBox("sayfa adı giriniz.")

Yeni hali:

SAYFA_ADI = Format(Date,"dd.mm.yyyy")

 

[yusuf1284]

Son makroda aşağıdaki kısmı değiştirip deneyin:

Eski hali:

SAYFA_ADI = Application.InputBox("sayfa adı giriniz.")

Yeni hali:

SAYFA_ADI = Format(Date,"dd.mm.yyyy")

Input varsayılan tarih yazılabilir mi aynı şekil.

SAYFA_ADI = Application.InputBox(Format(Date, "dd.mm.yyyy"))

Şunu denedim fakat olmadı

Çözdüm şu şekilde yaptım

SAYFA_ADI = Application.InputBox("Sayfa adını Giriniz.", "Tarih", Format(Date, "dd.mm.yyyy"))

 

[izistanbul]

Sub SAYFA_KOPYALA()
    Dim SAYFA_ADI As Variant

    SAYFA_ADI = Application.InputBox("sayfa adı giriniz.")

    If SAYFA_ADI = False Then
    MsgBox "İşleminiz iptal edilmiştir.", vbInformation
    Exit Sub: End If

    If SAYFA_ADI = "" Then
    MsgBox "Lütfen Sayfa adı giriniz. İşleminiz iptal edilmiştir.", vbInformation
    Exit Sub: End If

    Sheets("SABLON").Copy after:=Sheets(Sheets.Count)
 
    On Error Resume Next
    ActiveSheet.Name = SAYFA_ADI
    If Err = 1004 Then
    MsgBox "Aynı isimde sayfa bulunmaktadır. Eklenen son sayfa silinecektir.", vbCritical, "Dikkat !"
    Application.DisplayAlerts = False
    ActiveSheet.Delete
    Application.DisplayAlerts = True

    End If
 
End Sub

Bu kodda benzer sadece Sablon adındaki sayfayı kopyalıyor bana aktif sayfayı kopyalayan kod lazım

Arkadaşlar buradaki kodlar çok işime yaradı, şöyle bir sorum olacak "Örnek Şablon" sayfamı gizli yapmak istiyorum(denedim) fakat oradan kopyalama yapmayıp son sayfanın adını değiştiriyor(bu arada gizli sekme içerisinde kopyala-yapıştır sayfalar oluşturuyor).

Özetle şablonu gizleyerek buradan kopyala yapıp yeni sayfa nasıl açtırırım ? şimdiden vereceğiniz cevaplar için teşekkürler..

 

[YUSUF44]

Sheets("SABLON").Copy after:=Sheets(Sheets.Count)


Satırını aşağıdaki kodlarla değiştirip deneyin:

    With Sheets("SABLON")
        .Visible = True
        .Copy after:=Sheets(Sheets.Count)
        .Visible = False
    End With

 

[izistanbul]

Sheets("SABLON").Copy after:=Sheets(Sheets.Count)


Satırını aşağıdaki kodlarla değiştirip deneyin:

    With Sheets("SABLON")
        .Visible = True
        .Copy after:=Sheets(Sheets.Count)
        .Visible = False
    End With

Cevap için çok teşekkür ederim.
Dün en son şöyle bir sonuca ulaşmıştım tam gizleme ile yaptım fark olur mu bilmiyorum sanırım aynı işi görüyor. bu arada işlem için iptal dediğimde de hata veriyordu oraya da kodu ekledim.. belki birilerinin işine yarar diye aşağıya kodu ekledim.. Selamlarımla..

    Private Sub Yeni_Sayfa_Click()
    'Yeni_sayfa_aç_içeriği_kopyala
    Dim SAYFA_ADI As Variant
    Sheets("Örnek Şablon").Visible = True
    SAYFA_ADI = Application.InputBox("Sayfa adı giriniz.")

    If SAYFA_ADI = False Then
    MsgBox "İşleminiz iptal edilmiştir.", vbInformation
    Sheets("Örnek Şablon").Visible = xlSheetVeryHidden
    Exit Sub: End If

    If SAYFA_ADI = "" Then
    MsgBox "Lütfen Sayfa adı giriniz. İşleminiz iptal edilmiştir.", vbInformation
    Exit Sub: End If

    Sheets("Örnek Şablon").Copy after:=Sheets(Sheets.Count)
  
    On Error Resume Next
    ActiveSheet.Name = SAYFA_ADI
    If Err = 1004 Then
    MsgBox "Aynı isimde sayfa bulunmaktadır. Eklenen son sayfa silinecektir.", vbCritical, "Dikkat !"
    Application.DisplayAlerts = False
    ActiveSheet.Delete
    Application.DisplayAlerts = True
    End If
    Sheets("Örnek Şablon").Visible = xlSheetVeryHidden
End Sub

[/QUOTE]

 

[ahmettaskin]

Sub SAYFA_KOPYALA()
    Dim SAYFA_ADI As Variant

    SAYFA_ADI = Application.InputBox("sayfa adı giriniz.")

    If SAYFA_ADI = False Then
    MsgBox "İşleminiz iptal edilmiştir.", vbInformation
    Exit Sub: End If

    If SAYFA_ADI = "" Then
    MsgBox "Lütfen Sayfa adı giriniz. İşleminiz iptal edilmiştir.", vbInformation
    Exit Sub: End If

    Sheets("SABLON").Copy after:=Sheets(Sheets.Count)
 
    On Error Resume Next
    ActiveSheet.Name = SAYFA_ADI
    If Err = 1004 Then
    MsgBox "Aynı isimde sayfa bulunmaktadır. Eklenen son sayfa silinecektir.", vbCritical, "Dikkat !"
    Application.DisplayAlerts = False
    ActiveSheet.Delete
    Application.DisplayAlerts = True

    End If
 
End Sub

Bu kodda benzer sadece Sablon adındaki sayfayı kopyalıyor bana aktif sayfayı kopyalayan kod lazım

mrblar bana buna benzer bir kod lazımdı,,

aktif çalışma sayasındaki belirli bir aralığı (A1:Q33)
resim olarak yeni çalışma sayfasına aktaarmasını istiyorum

bu şekilde düzenleyebilir misinz acaba

 

[Korhan Ayhan]

Merhaba,

Deneyiniz.

Option Explicit

Sub Range_To_Picture()
    Dim Rng As Range
    
    Set Rng = Sheets("Sheet1").Range("A1:Q33")
    
    Rng.CopyPicture xlScreen, xlPicture
    Sheets.Add
    ActiveSheet.Paste

    Set Rng = Nothing
End Sub

 

[ahmettaskin]

Merhaba,

Deneyiniz.

Option Explicit

Sub Range_To_Picture()
    Dim Rng As Range
   
    Set Rng = Sheets("Sheet1").Range("A1:Q33")
   
    Rng.CopyPicture xlScreen, xlPicture
    Sheets.Add
    ActiveSheet.Paste

    Set Rng = Nothing
End Sub

ÇOK TEŞEKKÜR EDERİM.

ŞÖYLE BİR ŞEY EKLEME İMKANINIZ VAR MIDIR ACABA
SAYFA 1 DEN (A1:AV110) VE SAYFA2 DEN (A1:AR110) ARASINI RESİM OLARAK KOPYALAYIP "YENİ BİR ÇALIŞMA SAYFASI" NDA YAN YANA YAPIŞTIRSIN

KISACASI İKİ FARKLI ÇALIŞMA SAYFASINDAKİ ARALIĞI YENİ BİR ÇALIŞMA SAYFASINA RESİM OLARAK KAYDETMESİNİ İSTİYORUM

TEŞEKKÜRLER ŞİMDİDEN

 

[Korhan Ayhan]

Neden mesajlarınızı BÜYÜK harfle yazıyorsunuz.. Özel bir nedeni var mı?

 

[ahmettaskin]

Neden mesajlarınızı BÜYÜK harfle yazıyorsunuz.. Özel bir nedeni var mı?

özel bir nedeni yok , yazdığım sırada capslook açıkmış fark etmedim çok büyük küçük harf ayrıntısını . büyük harfle yazmanın sorun olduğunu da bilmiyordum kusura bakmayın .