+ Reply to Thread
Results 1 to 2 of 2

Macro to export specific range of data to text file for each worksheet

Hybrid View

  1. #1
    Registered User
    Join Date
    01-04-2013
    Location
    Ohio, USA
    MS-Off Ver
    Excel 2010, 2013
    Posts
    17

    Macro to export specific range of data to text file for each worksheet

    I am seeking help to write a code that will export variable ranges in each worksheet of a workbook to separate tab-delimited text files that have the same filename but are appended with the name of the worksheet they came from (e.g., \filename_03.txt, \filename_04.txt, ...). For example, I want data starting from I6 down to the last cell of data in column K. Columns I:K will be consistent, but the number of rows will not be the same for each worksheet. Column I has formulas for I6:I60000, so Range selection in code should probably select from K6 down, then over two columns to the left. I've tried writing this, but keep getting a error (see "ExportAll" code below). The range should then be exported to a tab-delimited text file. This should then be repeated for all but the last three worksheets.

    Code should do the following:

    -select range I6:K#, where # = number of rows from K6 thru the last occupied cell in K
    -output range to text file with specified filename appended with "_" & worksheet name
    -be prompted for filename and save location, ideally from same location as workbook
    -repeat for each consecutive worksheet, except for last three ("all","data","summary")
    -should take same filename indicated previously, just with a new appended name


    I have a code that will do this process for one worksheet at a time, but is rather cumbersome for multiple worksheets. (I found these macros on the Web: http://www.cpearson.com/excel/ImpText.aspx).


    ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    ' ExportToTextFile
    ' This exports a sheet or range to a text file, using a
    ' user-defined separator character.
    ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    Public Sub ExportToTextFile(FName As String, _
        Sep As String, SelectionOnly As Boolean, _
        AppendData As Boolean)
    
    Dim WholeLine As String
    Dim FNum As Integer
    Dim RowNdx As Long
    Dim ColNdx As Integer
    Dim StartRow As Long
    Dim EndRow As Long
    Dim StartCol As Integer
    Dim EndCol As Integer
    Dim CellValue As String
    
    
    Application.ScreenUpdating = False
    On Error GoTo EndMacro:
    FNum = FreeFile
    
    If SelectionOnly = True Then
        With Selection
            StartRow = .Cells(1).Row
            StartCol = .Cells(1).Column
            EndRow = .Cells(.Cells.Count).Row
            EndCol = .Cells(.Cells.Count).Column
        End With
    Else
        With ActiveSheet.UsedRange
            StartRow = .Cells(1).Row
            StartCol = .Cells(1).Column
            EndRow = .Cells(.Cells.Count).Row
            EndCol = .Cells(.Cells.Count).Column
        End With
    End If
    
    If AppendData = True Then
        Open FName For Append Access Write As #FNum
    Else
        Open FName For Output Access Write As #FNum
    End If
    
    For RowNdx = StartRow To EndRow
        WholeLine = ""
        For ColNdx = StartCol To EndCol
            If Cells(RowNdx, ColNdx).Value = "" Then
                CellValue = chr(34) & chr(34)
            Else
               CellValue = Cells(RowNdx, ColNdx).Value
            End If
            WholeLine = WholeLine & CellValue & Sep
        Next ColNdx
        WholeLine = Left(WholeLine, Len(WholeLine) - Len(Sep))
        Print #FNum, WholeLine
    Next RowNdx
    
    EndMacro:
    On Error GoTo 0
    Application.ScreenUpdating = True
    Close #FNum
    
    End Sub
    ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    ' END ExportTextFile
    ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    
    ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    ' DoTheExport
    ' This prompts the user for the FileName and the separtor
    ' character and then calls the ExportToTextFile procedure.
    ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    Sub DoTheExport()
        Dim Filename As Variant
        Dim Sep As String
        Filename = Application.GetSaveAsFilename(InitialFileName:=vbNullString, FileFilter:="Text Files (*.txt),*.txt")
        If Filename = False Then
            ''''''''''''''''''''''''''
            ' user cancelled, get out
            ''''''''''''''''''''''''''
            Exit Sub
        End If
        Sep = vbTab
        '"vbTab" outputs selection as tab-delimited'
        'to choose separator, use'
        'Sep = Application.InputBox("Enter a separator character.", Type:=2)'
        
        If Sep = vbNullString Then
            ''''''''''''''''''''''''''
            ' user cancelled, get out
            ''''''''''''''''''''''''''
            Exit Sub
        End If
        Debug.Print "FileName: " & Filename, "Separator: " & Sep
        ExportToTextFile FName:=CStr(Filename), Sep:=CStr(Sep), _
           SelectionOnly:=True, AppendData:=False
    End Sub
    ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    ' END DoTheExport
    ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

    I've also tried using the code below to process multiple worksheets, but I get an error on Line 28


    Sub ExportAll2()
    'http://stackoverflow.com/questions/10551353/saving-excel-worksheet-to-csv-files-with-filenameworksheet-name-using-vb
    
        Dim Filename As Variant
        Dim Sep As String
        Dim ws As Excel.Worksheet
        Dim SaveToDirectory As String
        Dim CurrentWorkbook As String
        Dim CurrentFormat As Long
        
        Filename = Application.GetSaveAsFilename(InitialFileName:=vbNullString, FileFilter:="Text Files (*.txt),*.txt")
        If Filename = False Then
            ''''''''''''''''''''''''''
            ' user cancelled, get out
            ''''''''''''''''''''''''''
            Exit Sub
        End If
    
    
        CurrentWorkbook = ThisWorkbook.FullName
        CurrentFormat = ThisWorkbook.FileFormat
        ' Store current details for the workbook
        Sep = vbTab
        
        For Each ws In ThisWorkbook.Worksheets
            ws.Range("K6", Range("K6").End(xlDown).Offset(0, -2).Address).Select
            'Sheets(WS.Name).Copy
            
            ThisWorkbook.Activate
            
            Debug.Print "FileName: " & Filename, "Separator: " & Sep
            ExportToTextFile FName:=CStr(Filename), Sep:=CStr(Sep), _
               SelectionOnly:=True, AppendData:=False
            
        Next ws
        
        'Application.DisplayAlerts = False
        'ActiveWorkbook.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

    Any suggestions on how to do this properly?

  2. #2
    Registered User
    Join Date
    01-04-2013
    Location
    Ohio, USA
    MS-Off Ver
    Excel 2010, 2013
    Posts
    17

    Re: Macro to export specific range of data to text file for each worksheet

    here is an example file. I would want the macro to process worksheets 03-06, but not "all", "data" or "summary". The exported files would then be: "\20120511_Au-cit_pH5_test_03.txt", "\20120511_Au-cit_pH5_test_04.txt", etc.
    Attached Files Attached Files

+ Reply to Thread

Thread Information

Users Browsing this Thread

There are currently 1 users browsing this thread. (0 members and 1 guests)

Similar Threads

  1. Export Each Column on Worksheet as Text File
    By ruezo in forum Excel Programming / VBA / Macros
    Replies: 8
    Last Post: 10-26-2012, 11:33 AM
  2. Transponse and Resize Range when Export to Text File
    By neobavesten in forum Excel Programming / VBA / Macros
    Replies: 0
    Last Post: 10-22-2009, 08:55 AM
  3. Replies: 0
    Last Post: 10-29-2008, 06:21 PM
  4. [SOLVED] macro to export a range to a text file?
    By icystorm@hotmail.com in forum Excel Programming / VBA / Macros
    Replies: 4
    Last Post: 07-21-2006, 09:30 AM
  5. [SOLVED] Export a Named range to Tab seperated text file
    By Peter Kamau in forum Excel General
    Replies: 1
    Last Post: 02-20-2006, 09:20 AM

Tags for this Thread

Bookmarks

Posting Permissions

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

Search Engine Friendly URLs by vBSEO 3.6.0 RC 1