VB kullanarak excel çalışma sayfasını dosya adı + çalışma sayfası adı ile CSV dosyalarına kaydetme

VB kodlamada çok yeniyim, birden fazla excel dosyası çalışma sayfasını csv'ye kaydetmeye çalışıyorum, bunu birden fazla sayfa için yapmayı bilmiyorum, ancak tek bir dosya için yapmanın bir yolunu buldum. Bu sitede yapmaya çalıştığım şey için çok yararlı olan kodlar buldum, tek sorun dosyaların çalışma sayfası adıyla kaydedilmesi, ancak ben bunları orijinal dosya ve çalışma sayfası adıyla kaydetmeye çalışıyorum, örneğin dosya adı_çalışma sayfası adı, bunu kendim yapmaya çalıştım ama hata almaya devam ediyorum, lütfen neyi yanlış yaptığımı söyleyebilir misiniz?

Kullandığım kod aşağıdaki gibidir:

   Public Sub SaveWorksheetsAsCsv()

   Dim WS As Excel.Worksheet
   Dim SaveToDirectory As String

   Dim CurrentWorkbook As String
   Dim CurrentFormat As Long

   CurrentWorkbook = ThisWorkbook.FullName
   CurrentFormat = ThisWorkbook.FileFormat
   ' Store current details for the workbook
   SaveToDirectory = "H:\test\"
   For Each WS In ThisWorkbook.Worksheets
   WS.SaveAs SaveToDirectory & WS.Name, xlCSV
   Next

Application.DisplayAlerts = False
ThisWorkbook.SaveAs Filename:=CurrentWorkbook, FileFormat:=CurrentFormat
Application.DisplayAlerts = True
' Temporarily turn alerts off to prevent the user being prompted
'  about overwriting the original file.

End Sub 
Çözüm

Sanırım istediğin şey bu.

Sub SaveWorksheetsAsCsv()

Dim WS As Excel.Worksheet
Dim SaveToDirectory As String

Dim CurrentWorkbook As String
Dim CurrentFormat As Long

CurrentWorkbook = ThisWorkbook.FullName
CurrentFormat = ThisWorkbook.FileFormat
' Store current details for the workbook
SaveToDirectory = "H:\test\"

For Each WS In Application.ActiveWorkbook.Worksheets
    WS.SaveAs SaveToDirectory & WS.Name, xlCSV
Next

Application.DisplayAlerts = False
ThisWorkbook.SaveAs Filename:=CurrentWorkbook, FileFormat:=CurrentFormat
Application.DisplayAlerts = True
' Temporarily turn alerts off to prevent the user being prompted
'  about overwriting the original file.

End Sub
Yorumlar (10)

Denediğin şey bu mu?

Option Explicit

Public Sub SaveWorksheetsAsCsv()
    Dim WS As Worksheet
    Dim SaveToDirectory As String, newName As String

    SaveToDirectory = "H:\test\"

    For Each WS In ThisWorkbook.Worksheets
        newName = GetBookName(ThisWorkbook.Name) & "_" & WS.Name
        WS.Copy
        ActiveWorkbook.SaveAs SaveToDirectory & newName, xlCSV
        ActiveWorkbook.Close Savechanges:=False
    Next
End Sub

Function GetBookName(strwb As String) As String
    GetBookName = Left(strwb, (InStrRev(strwb, ".", -1, vbTextCompare) - 1))
End Function
Yorumlar (2)

Bunu öğrenmenin en iyi yolu makroyu kaydetmek ve tam adımları uygulamak ve hangi VBA kodunu ürettiğini görmektir. daha sonra gidip genel hale getirmek istediğiniz parçaları değiştirebilirsiniz (yani dosya adları ve diğer şeyler)

Yorumlar (0)