Çalışma Kitabındaki sayfayı dışarıya excel olarak aktarmak

[meleklerim]

Bir uygulamamdaki F1 sayfasını
uygulamanın olduğu klasördeki RAPORLAR klasörüne
dışarıya aktardığım F1 sayfasındaki A1 hücresinin adını vererek
EXCEL olarak aktarmasını istiyorum.

Siteden ve youtubeden yararlanarak aşağıdaki kodları kendime uyarladım.

Ancak
Raporlar klasörüne değil de uygulamanın olduğu klasöre PDF olarak aktarıyor
Nereyi nasıl değiştirmem gerek?
selamlar


Sub F1AKTAR()
Worksheets("F1").Select
yol = ThisWorkbook.Path & RAPORLAR & "\"
isim = CreateObject("Scripting.FileSystemObject").GetBaseName(ThisWorkbook.Name) & " - " & _
ThisWorkbook.ActiveSheet.Range("A1").Text & ".xlsx"

ThisWorkbook.ActiveSheet.ExportAsFixedFormat Type:=XLSX, Filename:=yol & isim

MsgBox "Rapor Aktarıldı"
End Sub

 

[Tevfik_Kursun]

Merhaba Arkadaşım,
Dener misiniz, lütfen?

Sub Raporlara_Gotur()
Application.ScreenUpdating = False
Application.DisplayAlerts = False
    Dim newbook As Workbook
    Sheets("F1").Select
    Application.CutCopyMode = False
    dd = [A1] & ".xlsx"
    Yol = ThisWorkbook.Path & "\RAPORLAR\" & dd
    sayfa = ActiveSheet.Name
    Set newbook = Workbooks.Add
    ThisWorkbook.Sheets(sayfa).Cells.Copy
    newbook.Sheets(1).Range("A1").PasteSpecial xlPasteValuesAndNumberFormats
    newbook.SaveAs fileName:=Yol
    ActiveWorkbook.Close
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub

 

[meleklerim]

teşekkürler arkadaşım.
ancak ilgili F1 sayfasında koşullu biçimlendirmeler var. Onları almıyor

Merhaba Arkadaşım,
Dener misiniz, lütfen?

Sub Raporlara_Gotur()
Application.ScreenUpdating = False
Application.DisplayAlerts = False
    Dim newbook As Workbook
    Sheets("F1").Select
    Application.CutCopyMode = False
    dd = [A1] & ".xlsx"
    Yol = ThisWorkbook.Path & "\RAPORLAR\" & dd
    sayfa = ActiveSheet.Name
    Set newbook = Workbooks.Add
    ThisWorkbook.Sheets(sayfa).Cells.Copy
    newbook.Sheets(1).Range("A1").PasteSpecial xlPasteValuesAndNumberFormats
    newbook.SaveAs fileName:=Yol
    ActiveWorkbook.Close
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub

 

[Tevfik_Kursun]

Merhaba,
Bir örnek dosya koymuş olsanız daha kolay olur diye düşünüyorum
iyi çalışmalar