How to write a TXT from multiple sheets, same range, into one file?

user_18982749 0
Viewed 28

I am a real novice at VBA, so any help would be welcome. I am trying to convert certain ranges across multiple sheets into only one file. I have written code for a similar situation that produces a TXT file for each sheet, however now I need the same sheets/same ranges into only one TXT file. My original setup would produce about 30 files from 30 sheets, so now I would need all 30 sheets in a specific range in one file. Here is my original code:


Dim linetext As String
Dim myrange As Range
Dim FileName As String

' Next Sheet tab for conversion

FileName = ThisWorkbook.Path & "\" & "50002 LIGHTING" & ".txt"
Open FileName For Output As #1

Set myrange = Sheet1.Range("J11:L161")

For i = 1 To 150
    For j = 1 To 3
                linetext = IIf(j = 1, "", linetext & vbTab) & myrange.Cells(i, j)

            Next j
            
    Print #1, linetext
    Next i

    Close #1
FileName = ThisWorkbook.Path & "\" & Sheet5.Range("D7") & " " & Sheet5.Range("C6") & ".txt"
Open FileName For Output As #5

Set myrange = Sheet5.Range("J11:L161")

For i = 1 To 150
    For j = 1 To 3
                linetext = IIf(j = 1, "", linetext & vbTab) & myrange.Cells(i, j)

            Next j

    Print #5, linetext
    Next i

    Close #5

' Next Sheet tab for conversion

  
MsgBox (All Files Transformed from Excel to .TXT")
    
End Sub
vba excel
1 Answers

Export Ranges

Option Explicit

Sub ExportRanges()
    
    Const ExportFileName As String = "Test.txt"
    Const ExportRangeAddress As String = "J11:L161"
    
    Dim WorksheetObjects As Variant
    WorksheetObjects = VBA.Array(Sheet1, Sheet5)
    
    Dim FilePath As String: FilePath = ThisWorkbook.Path & "\" & ExportFileName
    Dim FileNum As Long: FileNum = FreeFile
    
    Open FilePath For Output As FileNum
    
        Dim Data As Variant
        Dim n As Long, rCount As Long, cCount As Long, r As Long, c As Long
        Dim LineText As String
        
        For n = 0 To UBound(WorksheetObjects)
            
            Data = WorksheetObjects(n).Range(ExportRangeAddress).Value
            
            If n = 0 Then
                rCount = UBound(Data, 1)
                cCount = UBound(Data, 2)
            End If
               
            For r = 1 To rCount
                For c = 1 To cCount
                    LineText = IIf(c = 1, "", LineText & vbTab) & Data(r, c)
                Next c
                Print #FileNum, LineText
            Next r
        
        Next n
        
    Close FileNum
        
    MsgBox "Ranges exported to text file.", vbInformation
    
End Sub
user_98140690
Related