简体   繁体   中英

VBA Export Excel to CSV with Range

I used the code that I found here .

After some changes this is the code I have now:

Option Explicit
Sub ExportAsCSV()

Dim MyFileName As String
Dim Item As String
Dim Path As String
Dim CurrentWB As Workbook, TempWB As Workbook
Path = "F:\Excels\csv export\"

Set CurrentWB = ActiveWorkbook
ActiveWorkbook.Worksheets("Nieuw Artikelnummer").UsedRange.Copy
Item = Range("D2")

Set CurrentWB = ActiveWorkbook
ActiveWorkbook.Worksheets("csv").UsedRange.Copy

Set TempWB = Application.Workbooks.Add(1)
With TempWB.Sheets(1).Range("A1")
  .PasteSpecial xlPasteValues
  .PasteSpecial xlPasteFormats
End With

MyFileName = Path & "\" & Item & ".csv"

Application.DisplayAlerts = False
TempWB.SaveAs filename:=MyFileName, FileFormat:=xlCSV, CreateBackup:=False, Local:=True
TempWB.Close SaveChanges:=False
Application.DisplayAlerts = True
MsgBox ".csv file has been created: " _
  & vbCrLf _
  & MyFileName
End Sub

The problem I have is that it uses the UsedRange, but I would like to select the Range that is copied into the new .csv file.

What can I do to select the Range to copy into the new file instead of the UsedRange?

This will open an input box on the article number sheet that allows you to hand select or type in a range:

Sub ExportAsCSV()

Dim MyFileName As String
Dim Item As String
Dim Path As String
Dim CurrentWB As Workbook, TempWB As Workbook
Dim myrangeNA As Range
Dim myRangeCSV As Range
Path = "F:\Excels\csv export\"

Set CurrentWB = ActiveWorkbook
ActiveWorkbook.Worksheets("Nieuw Artikelnummer").Activate
Set myrangeNA = Application.InputBox(prompt:="Select a range to copy", Type:=8)
Item = Range("D2")

Set TempWB = Application.Workbooks.Add(1)
myrangeNA.Copy Destination:=TempWB.Worksheets("Sheet1").Range("A1")

MyFileName = Path & "\" & Item & ".csv"

Application.DisplayAlerts = False
TempWB.SaveAs Filename:=MyFileName, FileFormat:=xlCSV, CreateBackup:=False, Local:=True
TempWB.Close SaveChanges:=False
Application.DisplayAlerts = True
MsgBox ".csv file has been created: " _
  & vbCrLf _
  & MyFileName
End Sub

If you don't want to select it, change the myrangeNA to whatever range you want, like range("A5:C20") and it should work.

For situations like this, I prefer to isolate the actions to a standalone Sub or Function that I can call with parameters. In this way I can reuse it as needed, either in this project or another one.

So I've separated the actions of copying the selected data range and pasting to a temporary workbook, then saving to a CSV file in it's own Function . The action returns a True/False result as a check for success.

Option Explicit

Sub test()
    Dim ws As Worksheet
    Set ws = ThisWorkbook.Sheets("Sheet1")

    Dim destCSVfile As String
    destCSVfile = "C:\Temp\" & ws.Range("D2")

    If ExportAsCSV(Selection, destCSVfile) Then
        MsgBox ".csv file has been created: " _
             & vbCrLf _
             & destCSVfile
    Else
        MsgBox ".csv file NOT created"
    End If
End Sub

Private Function ExportAsCSV(ByRef dataArea As Range, _
                             ByVal myFileName As String) As Boolean
    '--- make sure we have a range to export...
    ExportAsCSV = False
    If dataArea Is Nothing Then
        Exit Function
    End If

    dataArea.Copy

    '--- create a temporary workbook that will be saved as a CSV format
    Dim tempWB As Workbook
    Set tempWB = Application.Workbooks.Add(1)
    With tempWB.Sheets(1).Range("A1")
        .PasteSpecial xlPasteValues
        .PasteSpecial xlPasteFormats
    End With

    '--- suppress alerts to convert the temp book to CSV
    Application.DisplayAlerts = False
    tempWB.SaveAs filename:=myFileName, FileFormat:=xlCSV, _
                  CreateBackup:=False, Local:=True
    tempWB.Close SaveChanges:=False
    Application.DisplayAlerts = True
    ExportAsCSV = True
End Function

Your other two questions in the comment above mention pasting transposed values, which you would do by changing the line myrangeNA.Copy Destination:=TempWB.Worksheets("Sheet1").Range("A1") to

myrangeNA.Copy 
TempWB.Worksheets("Sheet1").Range("A1").PasteSpecial _ 
Paste:=xlPasteValues, Transpose:=True

This site is a great reference source for all the various objects and methods and properties in the Office VBA collection: https://docs.microsoft.com/en-us/office/vba/api/overview/excel/object-model (or https://docs.microsoft.com/de-de/office/vba/api/overview/excel/object-model if you prefer to have about five words translated to German)

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