csv Dosyası olarak kaydet

Z

ziya

Katılım
8 Nisan 2005
Mesajlar
789
Excel Vers. ve Dili
Excel 2010 Türkçe
Merhaba,
aşağıdaki kod ile parçalara böldüğüm dosyayı csv dosyası olarak katdetmiyor. Sanki txt dosya gibi kaydediyor. 24 sütunlu sayfadan herhangibir satırını örnek olarak ekledim.

15,X012025000007202,eArchive,Nihai,Nihai Nihai Nihai Nihai Müşteri,11111111111,76.09,0,76.09,0,0,0,0,0,69.17,6.92,0,0,0,0,7.31.2025,16:46,Nihai Nihai Nihai Nihai Nihai Müşteri,PAV860016430



Kullandığım kod aşağıda :
Kod: 
Sub SplitWorkbookToCSV()
    Dim srcWs     As Worksheet
    Dim newWb     As Workbook
    Dim chunkSize As Long: chunkSize = 500
    Dim lastRow   As Long
    Dim startRow  As Long, endRow As Long
    Dim partIndex As Long
    Dim baseName  As String, folderPath As String, filePath As String
    
    Set srcWs = ThisWorkbook.Sheets(1)
    lastRow = srcWs.Cells(srcWs.Rows.Count, "A").End(xlUp).Row
    If lastRow = 0 Then
        MsgBox "Veri bulunamadı!", vbExclamation
        Exit Sub
    End If
    
    baseName = Left(ThisWorkbook.Name, InStrRev(ThisWorkbook.Name, ".") - 1)
    folderPath = ThisWorkbook.Path
    If Right(folderPath, 1) <> "\" Then folderPath = folderPath & "\"
    
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    
    partIndex = 0
    For startRow = 1 To lastRow Step chunkSize
        partIndex = partIndex + 1
        endRow = startRow + chunkSize - 1
        If endRow > lastRow Then endRow = lastRow
        
        Set newWb = Workbooks.Add(xlWBATWorksheet)
        srcWs.Rows(startRow & ":" & endRow).Copy _
            Destination:=newWb.Sheets(1).Rows(1)
        
        filePath = folderPath & baseName & "_" & _
                   Format(partIndex, "00") & ".csv"
        newWb.SaveAs Filename:=filePath, _
                     FileFormat:=xlCSV, _
                     CreateBackup:=False
        newWb.Close SaveChanges:=False
    Next startRow
    
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
    
    MsgBox "Toplam " & partIndex & " dosya oluşturuldu.", vbInformation
End Sub
Yardım rica ediyorum
 
A

a_self_lion

Katılım
14 Ocak 2005
Mesajlar
807
Excel Vers. ve Dili
Microsoft Office Professional Plus 2021
Altın Üyelik Bitiş Tarihi
13/03/2022
ziya' Alıntı:
Merhaba,
aşağıdaki kod ile parçalara böldüğüm dosyayı csv dosyası olarak katdetmiyor. Sanki txt dosya gibi kaydediyor. 24 sütunlu sayfadan herhangibir satırını örnek olarak ekledim.

15,X012025000007202,eArchive,Nihai,Nihai Nihai Nihai Nihai Müşteri,11111111111,76.09,0,76.09,0,0,0,0,0,69.17,6.92,0,0,0,0,7.31.2025,16:46,Nihai Nihai Nihai Nihai Nihai Müşteri,PAV860016430


Kullandığım kod aşağıda :

Kod: 
Sub SplitWorkbookToCSV()
    Dim srcWs     As Worksheet
    Dim newWb     As Workbook
    Dim chunkSize As Long: chunkSize = 500
    Dim lastRow   As Long
    Dim startRow  As Long, endRow As Long
    Dim partIndex As Long
    Dim baseName  As String, folderPath As String, filePath As String
   
    Set srcWs = ThisWorkbook.Sheets(1)
    lastRow = srcWs.Cells(srcWs.Rows.Count, "A").End(xlUp).Row
    If lastRow = 0 Then
        MsgBox "Veri bulunamadı!", vbExclamation
        Exit Sub
    End If
   
    baseName = Left(ThisWorkbook.Name, InStrRev(ThisWorkbook.Name, ".") - 1)
    folderPath = ThisWorkbook.Path
    If Right(folderPath, 1) <> "\" Then folderPath = folderPath & "\"
   
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
   
    partIndex = 0
    For startRow = 1 To lastRow Step chunkSize
        partIndex = partIndex + 1
        endRow = startRow + chunkSize - 1
        If endRow > lastRow Then endRow = lastRow
       
        Set newWb = Workbooks.Add(xlWBATWorksheet)
        srcWs.Rows(startRow & ":" & endRow).Copy _
            Destination:=newWb.Sheets(1).Rows(1)
       
        filePath = folderPath & baseName & "_" & _
                   Format(partIndex, "00") & ".csv"
        newWb.SaveAs Filename:=filePath, _
                     FileFormat:=xlCSV, _
                     CreateBackup:=False
        newWb.Close SaveChanges:=False
    Next startRow
   
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
   
    MsgBox "Toplam " & partIndex & " dosya oluşturuldu.", vbInformation
End Sub
Yardım rica ediyorum
Genişletmek için tıkla ...

Kod: 
Sub SplitWorkbookToCSV()
    Dim srcWs As Worksheet
    Dim newWb As Workbook
    Dim chunkSize As Long: chunkSize = 500
    Dim lastRow As Long
    Dim startRow As Long, endRow As Long
    Dim partIndex As Long
    Dim baseName As String, folderPath As String, filePath As String
    
    Set srcWs = ThisWorkbook.Sheets(1)
    lastRow = srcWs.Cells(srcWs.Rows.Count, "A").End(xlUp).Row
    If lastRow = 0 Then
        MsgBox "Veri bulunamadı!", vbExclamation
        Exit Sub
    End If
    
    baseName = Left(ThisWorkbook.Name, InStrRev(ThisWorkbook.Name, ".") - 1)
    folderPath = ThisWorkbook.Path
    If Right(folderPath, 1) <> "\" Then folderPath = folderPath & "\"
    
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    Application.UseSystemSeparators = False
    Application.DecimalSeparator = ","
    Application.ThousandsSeparator = "."
    
    partIndex = 0
    For startRow = 1 To lastRow Step chunkSize
        partIndex = partIndex + 1
        endRow = startRow + chunkSize - 1
        If endRow > lastRow Then endRow = lastRow
        
        Set newWb = Workbooks.Add(xlWBATWorksheet)
        srcWs.Rows(startRow & ":" & endRow).Copy _
            Destination:=newWb.Sheets(1).Rows(1)
        
        filePath = folderPath & baseName & "_" & _
                   Format(partIndex, "00") & ".csv"
        newWb.SaveAs Filename:=filePath, _
                     FileFormat:=xlCSV, _
                     CreateBackup:=False
        newWb.Close SaveChanges:=False
    Next startRow
    
    Application.UseSystemSeparators = True
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
    
    MsgBox "Toplam " & partIndex & " dosya oluşturuldu.", vbInformation
End Sub
Dener misiniz bu kodları bölge ayarları ile ilgili yapıyor olabilir bu şekilde yaparsanız gerekli ayarlara döndürüp tekrar eski ayara alıyor.

Excel’in ayırıcı olarak noktalı virgül kullanması için

Application.UseSystemSeparators = False
Application.DecimalSeparator = ","
Application.ThousandsSeparator = "."

ve işlem bittiğinde tekrar eski haline döndürmek için

Application.UseSystemSeparators = True

kodlar yukarıda içine yazılı deneyip olup olmadığına bakınız.
İyi çalışmalar dilerim.
 
Z

ziya

Katılım
8 Nisan 2005
Mesajlar
789
Excel Vers. ve Dili
Excel 2010 Türkçe
a_self_lion' Alıntı:
Kod: 
Sub SplitWorkbookToCSV()
    Dim srcWs As Worksheet
    Dim newWb As Workbook
    Dim chunkSize As Long: chunkSize = 500
    Dim lastRow As Long
    Dim startRow As Long, endRow As Long
    Dim partIndex As Long
    Dim baseName As String, folderPath As String, filePath As String
   
    Set srcWs = ThisWorkbook.Sheets(1)
    lastRow = srcWs.Cells(srcWs.Rows.Count, "A").End(xlUp).Row
    If lastRow = 0 Then
        MsgBox "Veri bulunamadı!", vbExclamation
        Exit Sub
    End If
   
    baseName = Left(ThisWorkbook.Name, InStrRev(ThisWorkbook.Name, ".") - 1)
    folderPath = ThisWorkbook.Path
    If Right(folderPath, 1) <> "\" Then folderPath = folderPath & "\"
   
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    Application.UseSystemSeparators = False
    Application.DecimalSeparator = ","
    Application.ThousandsSeparator = "."
   
    partIndex = 0
    For startRow = 1 To lastRow Step chunkSize
        partIndex = partIndex + 1
        endRow = startRow + chunkSize - 1
        If endRow > lastRow Then endRow = lastRow
       
        Set newWb = Workbooks.Add(xlWBATWorksheet)
        srcWs.Rows(startRow & ":" & endRow).Copy _
            Destination:=newWb.Sheets(1).Rows(1)
       
        filePath = folderPath & baseName & "_" & _
                   Format(partIndex, "00") & ".csv"
        newWb.SaveAs Filename:=filePath, _
                     FileFormat:=xlCSV, _
                     CreateBackup:=False
        newWb.Close SaveChanges:=False
    Next startRow
   
    Application.UseSystemSeparators = True
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
   
    MsgBox "Toplam " & partIndex & " dosya oluşturuldu.", vbInformation
End Sub
Dener misiniz bu kodları bölge ayarları ile ilgili yapıyor olabilir bu şekilde yaparsanız gerekli ayarlara döndürüp tekrar eski ayara alıyor.

Excel’in ayırıcı olarak noktalı virgül kullanması için

Application.UseSystemSeparators = False
Application.DecimalSeparator = ","
Application.ThousandsSeparator = "."

ve işlem bittiğinde tekrar eski haline döndürmek için

Application.UseSystemSeparators = True

kodlar yukarıda içine yazılı deneyip olup olmadığına bakınız.
İyi çalışmalar dilerim.
Genişletmek için tıkla ...
Maalesef yine text dosyası gibi kaydetti. Tek sütunlu kayıt yaptı.
İlginize teşekkür ederim. Önerilerinizi bekliyorum.
Kesinlikle acil değil.
 
Z

ziya

Katılım
8 Nisan 2005
Mesajlar
789
Excel Vers. ve Dili
Excel 2010 Türkçe
a_self_lion' Alıntı:
Kod: 
Sub SplitWorkbookToCSV()
    Dim srcWs As Worksheet
    Dim newWb As Workbook
    Dim chunkSize As Long: chunkSize = 500
    Dim lastRow As Long
    Dim startRow As Long, endRow As Long
    Dim partIndex As Long
    Dim baseName As String, folderPath As String, filePath As String
   
    Set srcWs = ThisWorkbook.Sheets(1)
    lastRow = srcWs.Cells(srcWs.Rows.Count, "A").End(xlUp).Row
    If lastRow = 0 Then
        MsgBox "Veri bulunamadı!", vbExclamation
        Exit Sub
    End If
   
    baseName = Left(ThisWorkbook.Name, InStrRev(ThisWorkbook.Name, ".") - 1)
    folderPath = ThisWorkbook.Path
    If Right(folderPath, 1) <> "\" Then folderPath = folderPath & "\"
   
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    Application.UseSystemSeparators = False
    Application.DecimalSeparator = ","
    Application.ThousandsSeparator = "."
   
    partIndex = 0
    For startRow = 1 To lastRow Step chunkSize
        partIndex = partIndex + 1
        endRow = startRow + chunkSize - 1
        If endRow > lastRow Then endRow = lastRow
       
        Set newWb = Workbooks.Add(xlWBATWorksheet)
        srcWs.Rows(startRow & ":" & endRow).Copy _
            Destination:=newWb.Sheets(1).Rows(1)
       
        filePath = folderPath & baseName & "_" & _
                   Format(partIndex, "00") & ".csv"
        newWb.SaveAs Filename:=filePath, _
                     FileFormat:=xlCSV, _
                     CreateBackup:=False
        newWb.Close SaveChanges:=False
    Next startRow
   
    Application.UseSystemSeparators = True
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
   
    MsgBox "Toplam " & partIndex & " dosya oluşturuldu.", vbInformation
End Sub
Dener misiniz bu kodları bölge ayarları ile ilgili yapıyor olabilir bu şekilde yaparsanız gerekli ayarlara döndürüp tekrar eski ayara alıyor.

Excel’in ayırıcı olarak noktalı virgül kullanması için

Application.UseSystemSeparators = False
Application.DecimalSeparator = ","
Application.ThousandsSeparator = "."

ve işlem bittiğinde tekrar eski haline döndürmek için

Application.UseSystemSeparators = True

kodlar yukarıda içine yazılı deneyip olup olmadığına bakınız.
İyi çalışmalar dilerim.
Genişletmek için tıkla ...
Sorun yaşadığım dosya linki : Dosya Linki
İlginç olan bir şey daha var. Başka bir excel dosyamda devamlı kullandığım ve hiç sorun yaşamadığım aşağıdaki kod da bu excel dosyasında aynı sorunu yaşamama neden oluyor. Acaba bu excel dosyasını rapor olarak aldığım excel dosya formatında bir farklılık var. Başka dosyada sorun yaşamadığım kod aşağıda.
Kod: 
Sub CsvKaydet()


    Dim File_Path As String, X As Date, Say As Byte
    Dim Min_Date As Date, Max_Date As Date
    
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    
    File_Path = ThisWorkbook.Path
    
    Range("A2:Y" & Rows.Count).Sort Range("U2"), xlAscending

    Min_Date = WorksheetFunction.Min(Range("U:U"))
    Max_Date = WorksheetFunction.Max(Range("U:U"))
    
    

    For X = Min_Date To Max_Date Step 10
        Range("A1:Y" & Rows.Count).AutoFilter 2, ">=" & CLng(CDate(X)), xlAnd, "<=" & CLng(CDate(X + 9))
        If Cells(Rows.Count, 2).End(2).Row > 1 Then
            Range("A1:Y" & Cells(Rows.Count, 2).End(3).Row).Copy
            Workbooks.Add (1)
            Range("A1").PasteSpecial
            Range("A1").Select
            Columns.AutoFit
            Say = Say + 1
            'BU KOD ÇALIŞIYOR, ALTTAKİNİ DENEYECEĞİZ  ActiveWorkbook.SaveAs File_Path & "\" & "GELENNA_" & Format(Date, "yyyy_mm") & "_" & Say & " .csv", FileFormat:=xlCSV, Local:=True
            ActiveWorkbook.SaveAs File_Path & "\" & "GELENNA_" & Format(DateAdd("M", -1, Date), "yyyy_mm") & "_" & Say & " .csv", FileFormat:=xlCSV, Local:=True
            ActiveWorkbook.Close 0
        End If
    Next
    
    On Error Resume Next
    ActiveSheet.ShowAllData
    On Error GoTo 0
    
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
    
    Columns("A:F").Select
    Selection.AutoFilter
    Range("A2:Y2000").ClearContents
    Range("A102:Y2000").Delete Shift:=xlUp
    Range("A1").Select
    
    MsgBox "Veriler CSV formatında " & Say & " adet dosyaya aktarılmıştır.", vbInformation

End Sub
 
N

necati

Katılım
20 Şubat 2007
Mesajlar
700
Excel Vers. ve Dili
2007 Excel, Word Tr
ziya' Alıntı:
Merhaba,
aşağıdaki kod ile parçalara böldüğüm dosyayı csv dosyası olarak katdetmiyor. Sanki txt dosya gibi kaydediyor. 24 sütunlu sayfadan herhangibir satırını örnek olarak ekledim.

15,X012025000007202,eArchive,Nihai,Nihai Nihai Nihai Nihai Müşteri,11111111111,76.09,0,76.09,0,0,0,0,0,69.17,6.92,0,0,0,0,7.31.2025,16:46,Nihai Nihai Nihai Nihai Nihai Müşteri,PAV860016430

Genişletmek için tıkla ...
Merhaba,
Kullandığınız kodun farklı kaydet satırına "local:=True" eklemeniz yeterli olacak. Şu şekilde deneyin.
Kod: 
        newWb.SaveAs Filename:=filePath, _
                     FileFormat:=xlCSV, _
                     CreateBackup:=False, local:=True
 
Z

ziya

Katılım
8 Nisan 2005
Mesajlar
789
Excel Vers. ve Dili
Excel 2010 Türkçe
necati' Alıntı:
Merhaba,
Kullandığınız kodun farklı kaydet satırına "local:=True" eklemeniz yeterli olacak. Şu şekilde deneyin.
Kod: 
        newWb.SaveAs Filename:=filePath, _
                     FileFormat:=xlCSV, _
                     CreateBackup:=False, local:=True
Genişletmek için tıkla ...
Evet, sonuç dört dörtlük tamam.
Yardımcı oldunuz, çok teşekkür ederim.
 
Cevap yazmak için giriş yap yada kayıt ol.
Üst