简体   繁体   中英

Export a cell range into a new .csv file with VBA and save it without overwriting

All I am trying to do is copy, paste a cell range into a new CSV file and save the new file with VBA. I will might use this VBA for this file many times. So, I would like to make it save the files with a number.

I am using the code below and it is working:

Sub ExportRangetoFile()
Dim Rng As Range
Dim WorkRng As Range
Dim xFile As Variant
Dim xFileString As String
On Error Resume Next
xTitleId = "KutoolsforExcel"
Set WorkRng = Application.Selection
Set WorkRng = Application.InputBox("Range", xTitleId, WorkRng.Address, Type:=8)
Application.ActiveSheet.Copy
Application.ActiveSheet.Cells.Clear
WorkRng.Copy Application.ActiveSheet.Range("A1")
Set xFile = CreateObject("Scripting.FileSystemObject")
ActiveWorkbook.SaveAs Filename:="C:\Users\User\Desktop\Range.csv", FileFormat:=xlCSV, CreateBackup:=False
End Sub

The saved file with the cell range I selected from the original excel file is called Range. I want to change the code and make it save the files without overwriting any other file.

I presume this is the part I should change :

ActiveWorkbook.SaveAs Filename:="C:\Users\User\Desktop\Range.csv", FileFormat:=xlCSV, CreateBackup:=False

I tried to change the "False" to "True" but it did not work. Maybe for another reason though.

I just re-read the ? again. What you need is a way to get a new number and add it to the file name.

FiNum = ... 'get file number from a text file
FiName = "C:\Users\User\Desktop\Range" & FiNum & ".csv"
ActiveWorkbook.SaveAs Filename:=FiName, FileFormat:=xlCSV, CreateBackup:=False
FiNum = FiNum + 1
Call WriteToFile(FiNum)  ... 'write file number back to text file

Sub WriteToFile(ByVal FiNum As Long)
    Open "C:\FiNumber.txt" For Output As #1
    Print #1, CStr(FiNum) 'print as string for optimum results
    Close #1
End Sub

The technical post webpages of this site follow the CC BY-SA 4.0 protocol. If you need to reprint, please indicate the site URL or the original address.Any question please contact:yoyou2525@163.com.

 
粤ICP备18138465号  © 2020-2024 STACKOOM.COM