İstenilen dizine Dosyayı kaydetme

[Mx@Raid]

Arkadaşlar aşağıdaki kod ile sayfayı isetedğim adla kaydetmeye çalışıyorum, ancak dosya yolunda hata veriyor. yardımcı olabilir misiniz?

Sub CSV_DosyaKaydet()
Application.ScreenUpdating = False
Dim SonSatir, i As Integer
Dim Dizin As String
Set Vr = Sheets("Veri")
Set Aktr = Sheets("Aktar")
Dizin = Application.GetSaveAsFilename

For hcr = 2 To [A65536].End(xlUp).Row
Aktr.Cells(hcr - 1, 1) = Vr.Cells(hcr, 1) & Chr(44) & Vr.Cells(hcr, 2) & Chr(44) & Vr.Cells(hcr, 3) & Chr(44) & Vr.Cells(hcr, 4)
Next


With Aktr
SonSatir = .[A65536].End(3).Row
If SonSatir > 3 Then
Open App.Path & Dizin & ".csv" For Output As #1
For i = 1 To SonSatir
Print #1, Trim(Aktr.Cells(i, "A").Value)
Next i
Close #1
End If
End With

End Sub

 

[Korhan Ayhan]

Selamlar,

Kullandığınız kodu aşağıdaki şekilde değiştirip denermisiniz.

Option Explicit
 
Sub CSV_DOSYA_KAYDET()
    Dim S1 As Worksheet, S2 As Worksheet
    Dim KLASÖR As Object, DOSYA_YOLU As String, DOSYA_ADI As Variant
    Dim SON_SATIR As Long, X As Long, Y As Byte
    
    Set S1 = Sheets("Veri")
    Set S2 = Sheets("Aktar")
 
    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
    
    DOSYA_ADI = Application.InputBox("Lütfen dosya adını giriniz !", "DOSYA ADI")
    If DOSYA_ADI = "" Or DOSYA_ADI = False Then Exit Sub
    
    DOSYA_YOLU = KLASÖR.Self.Path & "\" & DOSYA_ADI & ".csv"
    Application.ScreenUpdating = False
    
    S2.Columns(1).ClearContents
    
    For X = 2 To S1.Range("A65536").End(3).Row
        For Y = 1 To S1.Range("IV1").End(1).Column
            If S2.Cells(X - 1, 1) = "" Then
                S2.Cells(X - 1, 1) = S1.Cells(X, Y)
                Else
                S2.Cells(X - 1, 1) = S2.Cells(X - 1, 1) & Chr(44) & S1.Cells(X, Y)
            End If
        Next
    Next
    With S2
        SON_SATIR = .Range("A65536").End(3).Row
        If .Range("A1") <> "" Then
        Open DOSYA_YOLU For Output As #1
        For X = 1 To SON_SATIR
        Print #1, Trim(S2.Cells(X, "A").Value)
        Next
        Close #1
        End If
    End With
    
    Set S1 = Nothing
    Set S2 = Nothing
    Set KLASÖR = Nothing
    
    Application.ScreenUpdating = True
    MsgBox "İşleminiz tamamlanmıştır.", vbInformation
End Sub

 

[Mx@Raid]

Sn. Korhan Ayhan teşekkür ederim çok işime yaradı, yalnız dosya adını da biz istediğimiz şekilde versek nasıl yapabiliriz.

 

[Korhan Ayhan]

Selamlar,

Üstteki mesajımdaki kodu güncelledim. İncelermisiniz.

 

[Mx@Raid]

Korhan Bey tekrar tekrar teşekkür ederim. Emeğinize sağlık.

 

[baydeniro]

Sayın Korhan Ayhan, cahilliğimi mazur görün. Bu kod ile içinde bulunulan dosyanın istenilen kataloğa kopyalanması mı sağlanıyor ?

 

[Mx@Raid]

Sn. serdarokan Dosya csv uzantılı olarak ve belirleyeceğimiz herhangibir dizine kaydediyor. Anlaşılabilir olması açısından dosya ekliyorum.

 

[baydeniro]

Sayın Mx@Raid ilginize çok teşekkür ederim. Herşeyi programın belirttiği gibi yaaptım ama olmadı. Yani kayıt olması gereken Kataloğu sordu ve belirttim, kayıt edilecek dosya adını sordu ve belirttim. En sonda "İşleminiz bitmiştir" mesajı çıktı. Ama o katalogda ve bilgisayarın hiçbiryerinde o isimde dosya yok.

 

[Mx@Raid]

Sn. Serdar Okan üç farklı yere deneme yaptım masaüstü, belgerim ve hdd nin d bölümü üç alanda da kayıt yaptı. Sizde neden bu sorunu yaşatı anlayamadım.

 

[baydeniro]

Sayın Mx@Raid ilginize çok teşekkür ederim. Size de zahmet verdim. Ben bunu bir de evde deneyeyim. Belki bilgisayar ile ilgili bir şey olabilir.

 

[malitogan]

Günaydın. Korhan Bey, çok güzel bir çalışma olmuş. Tam da aradığım gibi. Sadece farklı kaydederken virgülle ayrılmış .csv olarak kaydediyor. Bunu sütunlara ayrılmış olarak nasıl düzenleyebiliriz? Yardımcı olursanız sevinirim. İyi çalışmalar.

 

[Korhan Ayhan]

Merhaba,

Linkte benzer bir konu işlenmişti. CSV dosyasının sütun olarak gözükmesi için çözüm önerilerinde bulunmuştuk. İnceleyip kendi dosyanıza uyarlarlayabilirsiniz.

7000 bin satırlı excel dosyamı 120 satırlı dosyalar haline getirebilir miyim?

Bir excel dosyam var yedi bin satır, bunu 120 şer satır lar halinde bölüp 60 farklı dosya halinde getiriyorum. Bunu daha kolay bir yolla yapabilir miyim?

www.excel.web.tr

 

[malitogan]

Teşekkür ederim. İnceleyim.