PDA

View Full Version : Defining range to convert to CSV



millmo
08-21-2019, 09:09 AM
Hi,

I've got a macro written that exports an array of sheets from a workbook to CSV, however I've tried and failed to define the range it should export, rather than whatever excel defines as the default range. The code selects the desired range but then doesn't just copy and save it. Here's the code:



Sub ExportSheetsToCSV() Dim xWs As Worksheet
Dim xcsvFile As String
For Each xWs In Application.ActiveWorkbook.Worksheets(Array("0 (C)", "2 PostcodeGroupingTable", "11 Region Based Loading", "13 Postcode SP", "15 Risk Score SP", "19 Flat Fee"))
If xWs.Name = "0 (C)" Then xWs.Range("A1:A561,C1:C561").Select
Selection.Copy
'Change the file to suit the relevant destination folder
xcsvFile = "X:\Dept\_2019_05_16\Macro_Test" & "\" & xWs.Name & ".csv"
Application.ActiveWorkbook.SaveAs Filename:=xcsvFile, _
FileFormat:=xlCSV, CreateBackup:=False
Application.ActiveWorkbook.Saved = True
Application.ActiveWorkbook.Close
Next
End Sub


Any help would be much appreciated!

(The context of this is I'm exporting to CSV so I can import to SAS, and I need to have all the data - the excel-defined range sometimes cuts off data, and other times makes the files way too big)

Kenneth Hobs
08-21-2019, 10:13 AM
Welcome to the forum!

Try changing Main() to suit and see if this helps.


Sub Main() Dim ws As Worksheet, i As Integer, p$
p = ThisWorkbook.Path & "\"
For i = 3 To 4
Set ws = Worksheets(i)
RangeToCSVfile ws.UsedRange, p & ws.Name & ".csv"
Next i
End Sub


Sub RangeToCSVfile(Optional aRange As Range, Optional csvFile As Variant = "", _
Optional Overwrite As Boolean = True)
Dim calc As Integer, tf As Boolean, ws As Worksheet
'Tools > Settings > Microsoft Scripting Runtime
'Dim f As Folder, fso As New FileSystemObject
Dim f As Object, fso As Object

With Application
.EnableEvents = False
calc = .Calculation
.Calculation = xlCalculationManual
End With


'Set aRange if needed.
If Selection.Count > 1 And aRange Is Nothing Then Set aRange = Selection
On Error GoTo TheEnd
If aRange Is Nothing Then _
Set aRange = Application.InputBox("Range", "Selected: ", _
"=" & Selection.Address(external:=True), Type:=8)
On Error GoTo 0

'Check if folder in passed csvFile exists.
Set fso = CreateObject("Scripting.FileSystemObject")
If csvFile <> "" Then
tf = fso.FolderExists(fso.GetParentFolderName(csvFile))
End If
If tf = False Or csvFile = "" Then
csvFile = ThisWorkbook.Path
csvFile = Application.GetSaveAsFilename(csvFile, "Comma Separated Text (*.CSV), *.CSV")
End If

If csvFile <> "" And csvFile <> False Then
'Add new workbook, copy/paste aRange, name sheet 1.
Set ws = Workbooks.Add(xlWBATWorksheet).Worksheets(1)
aRange.Copy ws.[A1]
'ws.Name = fso.GetBaseName(csvFile)
If Overwrite Then Application.DisplayAlerts = False
ws.Parent.SaveAs csvFile, xlCSV, CreateBackup:=False
Application.DisplayAlerts = True
ws.Parent.Close False
End If


TheEnd:
Set fso = Nothing
With Application
.CutCopyMode = False
.EnableEvents = False
.Calculation = calc
End With
End Sub

snb
08-22-2019, 06:07 AM
Basically this is all you need:


Sub M_snb()
Set fs = CreateObject("scripting.filesystemobject")

fs.CreateTextFile "G:\OF\append.csv"

With GetObject("New:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}")
For Each it In ThisWorkbook.Sheets
For Each it1 In Array("A1:A561", "C1:C561")
it.Range(it1).Copy
.GetFromClipboard
fs.OpenTextFile("G:\OF\append.csv", 8).Write .GetText
Next
Next
End With

Application.CutCopyMode = False
End Sub