Farklı Kaydet

[acetinnster]

Merhabalar
Çalışmak ta olduğum excel sayfasının bir kopyasını aynı dizine .csv uzantılı olarak kaydetmem gerekiyor
Forumda araştırdım ancak bulamadım konu ile ilgili bilgisi olan var ise kodlar ile ilgili yardımcı olabilir mi?
Herkese teşekkür ederim.

 

[u.L.a.s]

merhaba

aşağıdaki kod düzeneği bulunduğunuz klasördeki excel dosyasını hem olduğu haliyle kaydeder hem de ayrıca csv dosyası olarak kaydeder

Sub saveRangeToCSV()

    Dim myCSVFileName As String
    Dim myWB As Workbook
    Dim tempWB As Workbook
    Dim rngToSave As Range

    Application.DisplayAlerts = False
    On Error GoTo err

    Set myWB = ThisWorkbook
    myCSVFileName = myWB.Path & "\" & "CSV-Exported-File-" & VBA.Format(VBA.Now, "dd-MMM-yyyy hh-mm") & ".csv"

    Set rngToSave = Range("C3:H50")
    rngToSave.Copy

    Set tempWB = Application.Workbooks.Add(1)
    With tempWB
        .Sheets(1).Range("A1").PasteSpecial xlPasteValues
        .SaveAs Filename:=myCSVFileName, FileFormat:=xlCSV, CreateBackup:=False
        .Close
    End With
err:
    Application.DisplayAlerts = True
End Sub

 

[acetinnster]

Sayın [B]u.L.a.s[/B] hocam çok teşekkürler verdiğiniz değerli bilgi için
bir kaç düzenleme yapma gereği duydum ancak ufak bir sıkıntım daha var csv uzantı kaydederken
çalışmakitabıadı.xlsm.csv olarak kaydetmek te .xlsm kısmı nasıl kaldırılabilir yapamadım açıkcası
konu hakkında yardımcı olabilirmisiniz.

tekrar teşekkürler


Dim myCSVFileName As String
Dim myWB As Workbook
Dim tempWB As Workbook
Dim rngToSave As Range

Application.DisplayAlerts = False
On Error GoTo err

Set myWB = ThisWorkbook
myCSVFileName = myWB.Path & "\" & ActiveWorkbook.Name & ".csv"

Set rngToSave = Range("A1:M100")
rngToSave.Copy

Set tempWB = Application.Workbooks.Add(1)
With tempWB
.Sheets(1).Range("A1").PasteSpecial xlPasteValues
.SaveAs Filename:=myCSVFileName, FileFormat:=xlCSV, CreateBackup:=False
.Close
End With
err:
Application.DisplayAlerts = True

 

[u.L.a.s]

Merhabalar

aşağıdaki şekilde deneyiniz

Sub saveRangeToCSV()

Dim myCSVFileName As String
Dim myWB As Workbook
Dim tempWB As Workbook
Dim rngToSave As Range

Application.DisplayAlerts = False
On Error GoTo err

Set myWB = ThisWorkbook
myCSVFileName = myWB.Path & "\" & Split(ActiveWorkbook.Name, ".")(0) & ".csv"


Set rngToSave = Range("A1:M100")
rngToSave.Copy

Set tempWB = Application.Workbooks.Add(1)
With tempWB
.Sheets(1).Range("A1").PasteSpecial xlPasteValues
.SaveAs Filename:=myCSVFileName, FileFormat:=xlCSV, CreateBackup:=False
.Close
End With
err:
Application.DisplayAlerts = True
End Sub

 

[acetinnster]

uLas hocam çok sağolun verdiğiniz bilgiler için
ancak yine problemim var bu sefer de csv kaydı yaptıktan sonra veriler b görselindeki gibi olmakta
bu şekilde değilde a görselindeki gibi olabilirmi

 

[u.L.a.s]

aşağıdaki gibi deneyiniz

Sub saveRangeToCSV()

Dim myCSVFileName As String
Dim myWB As Workbook
Dim tempWB As Workbook
Dim rngToSave As Range

Application.DisplayAlerts = False
On Error GoTo err

Set myWB = ThisWorkbook
myCSVFileName = myWB.Path & "\" & Split(ActiveWorkbook.Name, ".")(0) & ".csv"


Set rngToSave = Range("A1:M100")
rngToSave.Copy

Set tempWB = Application.Workbooks.Add(1)
With tempWB
.Sheets(1).Range("A1").PasteSpecial xlPasteValues
.SaveAs Filename:=myCSVFileName, FileFormat:=xlUnicodeText, CreateBackup:=False
.Close
End With
err:
Application.DisplayAlerts = True
End Sub