Belirlenen Sayfaları kaydetme

[Mx@Raid]

Arkadaşlar aşağıdaki kodla çalışma kitabındaki belirli sayfaları kaydetmek istiyorum ancak object varaible or With block variable not set hatası verdi.

Option Explicit
 
Sub Syf_Kaydet()

Application.ScreenUpdating = False

    Dim hpF, aData, sayfa As Worksheet
    Dim Klasör As Object, Dizin As String, DosyaAdı As Variant
    
    Set hpF = Sheets("HepatitFormu")
    Set aData = Sheets("arsivdata")
 
    Set Klasör = CreateObject("Shell.Application").BrowseForFoldeR(0, "Lütfen bir Klasör seçin !", 1)
 
    If Klasör Is Nothing Then
        MsgBox "İşleme devam edebilmek için lütfen Klasör seçiniz !", vbExclamation, "Dikkat !"
        Exit Sub
    End If
                
        DosyaAdı = UCase(Format(Date, "mmmm")) & Chr(45) & Format(Date, "yyyy")
            If DosyaAdı = "" Or DosyaAdı = False Then Exit Sub
            Dizin = Klasör.Self.Path & "\" & DosyaAdı & ".xls"
            
            If sayfa.Name = hpF & aData Then
                sayfa.Copy
            End If
            
    Set hpF = Nothing
    Set aData = Nothing
    Set Klasör = Nothing
    
    Application.ScreenUpdating = True
    MsgBox "İşleminiz tamamlanmıştır.", vbInformation
    
End Sub

 

[Mx@Raid]

Arkadaşlar yardımcı olabilirseniz sevinirim. Ay bitiyor ve temmuz ayına ait verileri silmem gerekiyor. Teşekkürler.

 

[turk-x]

Slm

Kodu Aşağıdaki şekilde değiştirirseniz işinizi görür

Sub Syf_Kaydet()

Application.ScreenUpdating = False

    
    Dim Klasör As Object, Dizin As String, DosyaAdı As Variant
    Set Klasör = CreateObject("Shell.Application").BrowseForFoldeR(0, "Lütfen bir Klasör seçin !", 1)
 
    If Klasör Is Nothing Then
        MsgBox "İşleme devam edebilmek için lütfen Klasör seçiniz !", vbExclamation, "Dikkat !"
        Exit Sub
    End If
                
        DosyaAdı = UCase(Format(Date, "mmmm")) & Chr(45) & Format(Date, "yyyy")
        If DosyaAdı = "" Or DosyaAdı = False Then Exit Sub
         Dizin = Klasör.Self.Path & DosyaAdı & ".xls"
    
   Sheets(Array("HepatitFormu", "arsivdata")).Select
   Sheets(Array("HepatitFormu", "arsivdata")).Copy
   ActiveWorkbook.SaveAs Filename:=Dizin
   ActiveWindow.Close
   
   Application.ScreenUpdating = True
   MsgBox "İşleminiz tamamlanmıştır.", vbInformation
    
End Sub

 

[Mx@Raid]

Sn. turk-x kaydettim yalnız zannedersem gözünüzden kaçmış,dizini de isim olarak giriyor. Arkadaşların kullandığı zaman yanılmamaları açısından eklemek istiyorum. Çok teşekkür ederim.
Dizin = Klasör.Self.Path & "\" & DosyaAdı & ".xls"

 

[turk-x]

Yok gözümden kaçmadı
ben onu bilerek o şekilde yaptım.
dizin tanımını Dizin = Klasör.Self.Path & "\" & DosyaAdı & ".xls" yapınca benim bilgisayarım da C dizini ni seçtiğimi varsayarsak :
dizin= c:\ & "\" & dosyaadi.xls olarak görüyor bu da C:\\dosyaadi.xls olmuş oluyor. Dolayısıyla hata mesajı veriyor.

İşinizi gördüyse sorun değil...

 

[baydeniro]

Teşekkürler Mxq@Raid.