Consulting

Results 1 to 3 of 3

Thread: Defining range to convert to CSV

  1. #1
    VBAX Newbie
    Joined
    Aug 2019
    Posts
    1
    Location

    Defining range to convert to CSV

    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)

  2. #2
    VBAX Guru Kenneth Hobs's Avatar
    Joined
    Nov 2005
    Location
    Tecumseh, OK
    Posts
    4,956
    Location
    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

  3. #3
    Knowledge Base Approver VBAX Wizard
    Joined
    Apr 2012
    Posts
    5,635
    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

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •