Sayfa1'de Belirli Hücredeki Verileri Farklı Kaydetme.

[ottoman71]

Merhaba Arkadaşlar,
Sayfa1'de A2:S sütunu arasındaki verileri farklı kaydetmek istiyorum ama bir türlü başaramadım. Sayfa bazında farklı kaydeten makrolar buldum ama o sayfa içerisindeki makroları ve butonları da kayıt ediyor.
Benim istediğim A2 ile S sütununda boş olan hücreye kadar olan verileri xls olarak "C:\Yedek" klasörünün içerisine farklı kaydetmek.

Yardımcı olabilirmisiniz.

 

[Korhan Ayhan]

Selamlar,

Aşağıdaki kodu denermisiniz.

Kodun sağlıklı çalışması için aşağıdaki ayarlamayı yapmalısınız.

ARAÇLAR-MAKRO-GÜVENLİK menüsünü açın.
Açılan penceredeki "Güvenilen Yayımcılar" sekmesine tıklayın.
En alttaki "Visual Basic Erişimine Güven" seçeneğini işaretleyin ve tamam tuşuna basarak işlemi tamamlayın.

Bu işlemden sonra kodu çalıştırırsanız problem yaşamazsınız.

Private Sub CommandButton2_Click()
    Dim Dosya_Sistemi As Object, Dosya_Yolu As String, Dosya_Adı As String
    Dim VBComps As Object, VBComp As Object
    
    Dosya_Yolu = "C:\YEDEK"
    Dosya_Adı = "Deneme"
    
    Set Dosya_Sistemi = CreateObject("Scripting.FileSystemObject")
    
    If Not Dosya_Sistemi.FolderExists(Dosya_Yolu) Then
        Dosya_Sistemi.CreateFolder (Dosya_Yolu)
    End If
    
    Application.ScreenUpdating = False
    
    If Dir(Dosya_Yolu & Application.PathSeparator & Dosya_Adı & ".xls", vbNormal) = "" Then
        ActiveSheet.Copy
        On Error Resume Next
        ActiveSheet.DrawingObjects.Delete
        On Error GoTo 0
        
        ActiveWorkbook.SaveCopyAs Filename:=Dosya_Yolu & Application.PathSeparator & Dosya_Adı & ".xls"
        Set VBComps = ActiveWorkbook.VBProject.VBComponents
        For Each VBComp In VBComps
            Select Case VBComp.Type
                Case 100
                    With VBComp.CodeModule
                        .DeleteLines 1, .CountOfLines
                    End With
                Case Else
                    VBComps.Remove VBComp
            End Select
        Next VBComp
        
        Set VBComps = Nothing
        ActiveWorkbook.Close 0
        Application.ScreenUpdating = True
        MsgBox "Yedekleme işlemi tamamlanmışır.", vbInformation
    Else
        MsgBox "Yedekleme işlemi iptal edilmiştir !", vbExclamation
    End If
    Set Dosya_Sistemi = Nothing
    Set VBComps = Nothing
End Sub

 

[ottoman71]

Korhan Hocam;
İlgilendiğiniz için teşekkur ederim.
Belirtilen adrese dosyayı oluşturuyor fakat komple sayfa içerisini alıyor. Yani örnek olarak gönderdiğim dosyadaki textbox ve butonlarıda deneme.xls dosyasının içerisine atıyor.
Verileri sadece A2 ile S sütunundaki boş satıra kadar almasını sağlayabilirmiyiz. Makroları almayacak.
Ayrıca makroyu çalıştırdıktan sonra book1 adında kitap açıyor ve "programmatic access to visual basic project is not trusted" (visual basic proje programlı erişim güvenilir değil) hatası veriyor.
Bu hatayı Set VBComps = ActiveWorkbook.VBProject.VBComponents satırında veriyor.

 

[Korhan Ayhan]

Selamlar,

Üstteki mesajımdaki kodu güncelledim. Ayrıca aldığınız hata mesajını nasıl düzelteceğinize anlatan bir not ekledim. İncelermisiniz.

 

[ottoman71]

Korhan Hocam;
Makro güvenlik ayarları zaten en altta. Tekrar kontrol ettim güvenlik ayarlarında bir sorun yok.
Bu hatanın nedeni fabrika bilgisayarını kullanıyorum ve kullanıcı hesabı sınırlı. Bundan dolayı olabilir mi?

Diğer sorunlar düzeldi. Sadece bu hatayı veriyor. Eğer uğraştıracaksa da gerek yok programı end olarak sonlandırıyorum.

İlgilendiğiniz için tekrar teşekkur ederim.

 

[Korhan Ayhan]

Selamlar,

Lütfen önceki mesajımdaki açıklamalarımı dikkatli okuyunuz. Yanlış anlamışsınız.

 

[ottoman71]

Hocam evet dediğiniz gibi yanlış anlamışım. Sorun düzeldi.
Çok teşekkur ederim
İyi çalışmalar.

 

[baydeniro]

Çok teşekkürler sayın Korhan Ayhan.