• DİKKAT

    DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
    Altın Üyelik Hakkında Bilgi

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

S

sebastianmbl

Katılım
25 Kasım 2012
Mesajlar
34
Excel Vers. ve Dili
2010 türkçe
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.
 
Buyurun.:cool:
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
 
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
 
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
Genişletmek için tıkla ...

Çalışma sayfasından kastınız çalışma kitabımı(Excel dosyası).Çalışma sayfası bir kitaptaki sayfa sekmelerinden oluşur.
 
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
 
Buyurun.:cool:
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
 
Buyurun.:cool:
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
 
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
 
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
Genişletmek için tıkla ...

Kaynak dosyadaki kodu çalıştırınız.:cool:
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
 

Ekli dosyalar

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
 
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
Genişletmek için tıkla ...
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
 
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..
 
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
Genişletmek için tıkla ...
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 ?
 
Orion1' Alıntı:
Buyurun.:cool:
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
Genişletmek için tıkla ...


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 ?
 
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
 
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
 
Yardımcı olabilecek var mı? Bir de aktif tarihi atsa sayfa adını 04.04.2021 yani BUGÜN() yapsa
 
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
Genişletmek için tıkla ...


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
 
Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst