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

sebastianmbl · 29 Eylül 2015

Herkese merhabalar

İki adet excel çalışma sayfamız bulunmaktadır;

1. excel sayfamızda ki veriler formüller ile sürekli değişecektir,

Bundan dolayı 1.excel sayfamızda bir buton oluşturuldu ve bu butona atanan makro ile 1.excel sayfasını tamamem 2. excel boş çalışma sayfasına kopyalamayı amaçlıyorum.

Fakat
Butono her basıldığında 2. excel dosyasında yeni sekmeler açarak o an ki verileri kopyalaması ve formüllerden arındırmış bir şekilde yapıştır "123" kopyalaması gerekmektedir.

Aşağıda yine forum da bulduğum bir makro vardır yalnız bu makroda seçilen kopyalama alanını aynı çalışma sayfasında yeni sekme açarak yapıştırmaktadır ve formülleri arındırmamaktadır.

Site içerisinde buluna makro aşağıda ki gibidir;

Sub asd_Tıklat()
Sub SayfaKopyala()

Dim sh As Worksheet

Set sh = Sheets(ActiveSheet.Name)
Application.DisplayAlerts = False

sh.Copy After:=Sheets(sh.Name)
ActiveSheet.Name = Val(sh.Name) + 1

End Sub

Formüllü düzenlemek içi yardımcı olmanızı rica ederim.

Orion1 · 29 Eylül 2015

Buyurun.

Kod:

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").PasteSpecial xlPasteValuesAndNumberFormats
Application.CutCopyMode = False
Range("A1").Select
MsgBox "Sayfa eklendi ve kopyalama yapıldı." & vbLf & "evrengizlen@hotmail.com"
End Sub

sebastianmbl · 30 Eylül 2015

Orion1 merhaba,

Öncelikle kod için çok teşekkürler, yalnızca bu kod ile yeni çalışma sayfasına yeni sekmeler açmak yerine aynı çalışma sayfasında yeni sekmeler açarak devam ediyor.

Acaba bu durumu da yapabilirsek tam olacak.

Teşekkürler

Orion1 · 30 Eylül 2015

sebastianmbl' Alıntı:
Orion1 merhaba,

Öncelikle kod için çok teşekkürler, yalnızca bu kod ile yeni çalışma sayfasına yeni sekmeler açmak yerine aynı çalışma sayfasında yeni sekmeler açarak devam ediyor.

Acaba bu durumu da yapabilirsek tam olacak.

Teşekkürler

Çalışma sayfasından kastınız çalışma kitabımı(Excel dosyası).Çalışma sayfası bir kitaptaki sayfa sekmelerinden oluşur.

sebastianmbl · 30 Eylül 2015

Evet yeni bir çalışma kitabında her tıklamada yeni sekmeler açarak devam etmeyi amaçlıyorum.

Yardımcı olduğunuz için teşekkürler

Orion1 · 30 Eylül 2015

Buyurun.

Kod:

Sub yenidosya59()
Dim newbook As Workbook
    yol = ThisWorkbook.Path
    sayfa = ActiveSheet.Name
    Set newbook = Workbooks.Add
    ThisWorkbook.Sheets(sayfa).Cells.Copy
    newbook.Sheets(1).Range("A1").PasteSpecial xlPasteValuesAndNumberFormats
    newbook.SaveAs Filename:=yol & "\" & sayfa & " " & Format(Date, "ddmmyy") & " " & Format(Time, "hhmmss") & ".xlsx"
End Sub

Orion1 · 30 Eylül 2015

Buyurun.

Kod:

Sub yenidosya59()
Dim newbook As Workbook
    yol = ThisWorkbook.Path
    sayfa = ActiveSheet.Name
    Set newbook = Workbooks.Add
    ThisWorkbook.Sheets(sayfa).Cells.Copy
    newbook.Sheets(1).Range("A1").PasteSpecial xlPasteValuesAndNumberFormats
    newbook.SaveAs Filename:=yol & "\" & sayfa & " " & Format(Date, "ddmmyy") & " " & Format(Time, "hhmmss") & ".xlsx"
End Sub

sebastianmbl · 30 Eylül 2015

Hocam sagolun
Burdada her tıkladımızda yeni 'çalışma kitabı' açılıyor.
Peki birkez tıklamadan sonra oluşan yeni kitabın içinde sekmeler açarak devam etme gibi bir durum için bir değişiklik yapılabilir mi?

Veya belirlenen bir çalışma kitabından sekmeler açarak devam etse her seferinde yeni açmak olabilir mi?

Teşekkürler

Orion1 · 30 Eylül 2015

sebastianmbl' Alıntı:
Hocam sagolun
Burdada her tıkladımızda yeni 'çalışma kitabı' açılıyor.
Peki birkez tıklamadan sonra oluşan yeni kitabın içinde sekmeler açarak devam etme gibi bir durum için bir değişiklik yapılabilir mi?

Veya belirlenen bir çalışma kitabından sekmeler açarak devam etse her seferinde yeni açmak olabilir mi?

Teşekkürler

Kaynak dosyadaki kodu çalıştırınız.

Kod:

Sub kopyalasayfa59()
Dim s1 As Worksheet, s2 As Worksheet, wb As Workbook
Set s1 = ActiveSheet
Application.DisplayAlerts = False
If Workbooks.Open(ThisWorkbook.Path & "\Hedefdosya.xlsx").ReadOnly = True Then
    Workbooks("Hedefdosya.xlsx").Close False
End If
Application.DisplayAlerts = True
Set wb = Workbooks("Hedefdosya.xlsx")
wb.Worksheets.Add after:=wb.Sheets(wb.Sheets.Count)
Set s2 = wb.ActiveSheet
s1.Cells.Copy
s2.Range("A1").PasteSpecial xlPasteValuesAndNumberFormats
Application.CutCopyMode = False
Range("A1").Select
Set s1 = Nothing
Set s2 = Nothing
Set wb = Nothing
MsgBox "Sayfa kopyalandı." & vbLf & "evrengizlen@hotmail.com"
End Sub

sebastianmbl · 1 Ekim 2015

Hocam sagolun
Tam istenilen gibi oldu.

Teşekkürler

Orion1 · 1 Ekim 2015

sebastianmbl' Alıntı:
Hocam sagolun
Tam istenilen gibi oldu.

Teşekkürler

Rica ederim.
İyi çalışmalar.

sebastianmbl · 3 Ekim 2015

Tekrar merhaba,

Öncelikle Orion hocamızın yazdığı bu formülüm tam olarak ihtiyacı karşıladığını belirtmek isterim,

Alternatif olarak

bu formül direk olarak tüm sekmeyi kopyalamaktadır,

Tüm sekme değilde, sekme içerisinde yalnız seçilen alanı kopyalaması için nasıl değişiklik yapılabilir.

Zamanla görülmüştür ki tüm sekme içerisinde ki bilgi çok büyük olduğundan işlem uzun sürmektedir. bundan dolaya böyle bir çözüm aranmaktadır.

Teşekkürler

Orion1 · 3 Ekim 2015

sebastianmbl' Alıntı:
Tekrar merhaba,

Öncelikle Orion hocamızın yazdığı bu formülüm tam olarak ihtiyacı karşıladığını belirtmek isterim,

Alternatif olarak

bu formül direk olarak tüm sekmeyi kopyalamaktadır,

Tüm sekme değilde, sekme içerisinde yalnız seçilen alanı kopyalaması için nasıl değişiklik yapılabilir.

Zamanla görülmüştür ki tüm sekme içerisinde ki bilgi çok büyük olduğundan işlem uzun sürmektedir. bundan dolaya böyle bir çözüm aranmaktadır.

Teşekkürler

Kod:

s1.Cells.Copy

Yukarıdaki kod tüm sayfayı kopyalamaktadır.
Aşağıdaki kodda A:E aralığını kopyalamaktadır.

Kod:

s1.range("A:E").copy

nsynsy · 15 Şubat 2020

Merhaba Sayın @Orion1 kodunuzu bende kullandım elleriniz dert görmesin. Yalnız bu kodla aktif sayfadaki metinleri yeni sayfaya kopyalamaktadır. Aktif Sayfadaki hücre biçimleri satır ve sutun genişlikleri, sayfada bulunan nesneleri kopyalamaktadır. Mevcut kodu buna göre güncelleyebilirmisiniz. Bir şey daha Aktif Sayfadan Yeni Çalışma kitabına kopyalama yaptığında önce Yeni Çalışma Kitabını açmakta ve sonra Sayfa4'e yapıştırmaktadır. Yeni çalışma kitabını kapatmazsak kodu yeniden çalıştırdığımızda Sayfa4'ün üzerine kopyalamaya devam etmektedir.

Ayrıca Mevcut sayfada bir hucreden aldırabilirmiyiz Yeni Çalışma Kitabındaki Sayfa adını?

Şimdiden teşekkürler..

Perfect07 · 14 Ağustos 2020

Orion1' Alıntı:
Kod:

s1.Cells.Copy

Yukarıdaki kod tüm sayfayı kopyalamaktadır.
Aşağıdaki kodda A:E aralığını kopyalamaktadır.

Kod:

s1.range("A:E").copy

Hocam yeni sayfaya aktarıyor fakat tema farklı geliyor yani exceldeki hücre birleştirmelere yazı tipi vs kopyalanmıyor onun için ne yapabiliriz çok teşekkürler

yusuf1284 · 3 Nisan 2021

Orion1' Alıntı:

Buyurun.

Kod:

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").PasteSpecial xlPasteValuesAndNumberFormats
Application.CutCopyMode = False
Range("A1").Select
MsgBox "Sayfa eklendi ve kopyalama yapıldı." & vbLf & "evrengizlen@hotmail.com"
End Sub

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 ?

yusuf1284 · 3 Nisan 2021

Kod:

Sub Kopyala()
Sheets("Sayfa1").Visible = True
Sheets("Sayfa1").Copy After:=Worksheets(Worksheets.Count)
10 NewPageName = InputBox("Kopyalamak Üzere Olduğunuz Sayfanın Adını Belirleyiniz...!!!")
For a = 1 To Sheets.Count
If UCase(Sheets(a).Name) = UCase(NewPageName) Then
MsgBox "Seçtiğiniz sayfa adı mevcuttur yeniden deneyin."
GoTo 10
End If
Next
ActiveWindow.ActiveSheet.Name = NewPageName
End Sub

Şöyle bir kod buldum fakat aktif sayfayı kopyala komutunu yerleştiremedim sadece sayfa1 adındaki sayfayı kopyalıyor

yusuf1284 · 3 Nisan 2021

Kod:

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

yusuf1284 · 4 Nisan 2021

Yardımcı olabilecek var mı? Bir de aktif tarihi atsa sayfa adını 04.04.2021 yani BUGÜN() yapsa

YUSUF44 · 4 Nisan 2021

yusuf1284' Alıntı:
Kod:

Sub Kopyala() Sheets("Sayfa1").Visible = True Sheets("Sayfa1").Copy After:=Worksheets(Worksheets.Count) 10 NewPageName = InputBox("Kopyalamak Üzere Olduğunuz Sayfanın Adını Belirleyiniz...!!!") For a = 1 To Sheets.Count If UCase(Sheets(a).Name) = UCase(NewPageName) Then MsgBox "Seçtiğiniz sayfa adı mevcuttur yeniden deneyin." GoTo 10 End If Next ActiveWindow.ActiveSheet.Name = NewPageName End Sub

Şöyle bir kod buldum fakat aktif sayfayı kopyala komutunu yerleştiremedim sadece sayfa1 adındaki sayfayı kopyalıyor

Aşağıdaki gibi deneyin:

PHP:

Sub Kopyala()
Sheets("Sayfa1").Visible = True
ActiveSheet.Copy After:=Worksheets(Worksheets.Count)
10 NewPageName = InputBox("Kopyalamak Üzere Olduğunuz Sayfanın Adını Belirleyiniz...!!!")
For a = 1 To Sheets.Count
    If UCase(Sheets(a).Name) = UCase(NewPageName) Then
        MsgBox "Seçtiğiniz sayfa adı mevcuttur yeniden deneyin."
        GoTo 10
    End If
Next
ActiveWindow.ActiveSheet.Name = NewPageName
End Sub

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

sebastianmbl

Orion1

Uzman

sebastianmbl

Orion1

Uzman

sebastianmbl

Orion1

Uzman

Orion1

Uzman

sebastianmbl

Orion1

Uzman

Ekli dosyalar

sebastianmbl

Orion1

Uzman

sebastianmbl

Orion1

Uzman

nsynsy

Perfect07

yusuf1284

yusuf1284

yusuf1284

yusuf1284

YUSUF44

Destek Ekibi