Makro ile Sayfa Kopyalama

[sefaburan]

Arkadaşlar selamlar.

Sadece bir buton yardımı ile makro kodları, biçimlendirmeleri falan tamamen aynı olmak üzere çalıştığım sayfayı istediğim bir isimle yani farklı bir isimle kopyalamamı sağlayacak makro kodu var mı.

 

[Muhammet Okumuş]

http://www.excel.web.tr/f48/sayfayy-kopyala-ve-ad-ver-t101774.html
linki inceleyiniz.

 

[sefaburan]

http://www.excel.web.tr/f48/sayfayy-kopyala-ve-ad-ver-t101774.html
linki inceleyiniz.

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

kodu ile sorunumu aştım teşekkürler.

konuyu silmiyorum faydalanmak isteyen kullanabilir.

 

[TUNCA ERSİN]

Sy. hocam ;

aşağıda ki kodda benim sizden istediğim bende sayfa1 ' i aktarma yapabiliyorum ama sayfa2 , sayfa3 ve farklı adlardaki belirli sayfaları da aktarmak istiyorum nasıl yapa bilirim.

Sub banka_hazır()
Dim tW As Workbook, nW As Workbook
Dim sS As Long
Dim DosyaAdi As String

Application.ScreenUpdating = False
Application.DisplayAlerts = False


Set tW = ThisWorkbook
DosyaAdi = Format(DateTime.Now, "dd.mm.yyyy hh.mm.ss ") & ("& banka ve Nakit")
'DosyaAdi = tW.Path & "\" & DosyaAdi & ".xlsx" 'Bu satiri deaktif edip aşağıdaki satırı aktif edin
DosyaAdi = "C:\Users\Ersin Tunca\Desktop\hazır" & "\" & DosyaAdi & ".xlsx"
sS = tW.Sheets("sayfa1").Cells(Rows.Count, 2).End(xlUp).Row

Set tW = ThisWorkbook
tW.Sheets("sayfa1").Range("A1:n" & sS).Copy

Set nW = Workbooks.Add
nW.Worksheets(1).Range("A1").PasteSpecial xlPasteFormats
nW.Worksheets(1).Range("A1").PasteSpecial xlPasteColumnWidths
nW.Worksheets(1).Range("A1").PasteSpecial xlPasteValuesAndNumberFormats 'xlPasteValues

nW.SaveAs DosyaAdi
nW.Close True

Application.CutCopyMode = False
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub