Copy range and save as a new text file

[spycein]

Hello everyone,
I looking for a VBA macro code which would copy a specified column range and save the same as text file.
For example, when i click the command button the code will copy the assigned range and ask for the path & file name to save the file.
Regards,
Shib

 

[bobby786]

This should work, letting you select columns, rows, or a range and saves the file as TXT (with tabs, but that could be changed). It does not copy anything or make new sheets, it just takes the selection (or trims it if whole columns or rows are selected to the last used cell in the column or row) and saves it. Note it requires the worksheet to be Sheet1.

Option Explicit
Sub SaveTXTselection()
   
    Dim strLine As String
    Dim intRow As Integer
    Dim booFirstCell As Boolean
    If Selection.Address = "$1:$1048576" Then Range(Sheet1.UsedRange.Address).Select ' if the whole sheet is selected then reduce it to the used range
    If UBound(Split(Selection.Address, "$")) = 2 Then
    ' whole column(s) or whole row(s) selected so we need to limit the output to the used range within the columns or rows
        If IsNumeric(Split(Split(Selection.Address, "$")(1), ":")(0)) Then
            ' whole row(s), so re-select to column A plus the extent of the used range's columns since the rest is empty
            Range("A" & Split(Selection.Address, "$")(1) & Split(Sheet1.UsedRange.Address, "$")(3) & Split(Selection.Address, "$")(2)).Select
        Else
            ' whole column(s), so re-select row 1 plus the extent of the used range's rows since the rest is empty
            Range(Split(Split(Selection.Address, "$")(1), ":")(0) & "1:" & Split(Selection.Address, "$")(2) & Split(Sheet1.UsedRange.Address, "$")(4)).Select
        End If
    End If
    intRow = Split(Split(Selection.Address, "$")(2), ":")(0)
    booFirstCell = True
   
    Dim varSaveAsTxt As Variant
    ' displays the save file dialog (file name only required, the .txt will be added)
    varSaveAsTxt = Application.GetSaveAsFilename(FileFilter:="Text (Tab delimited) (*.txt), *.txt")
    ' check to make sure the user hasn't pressed cancel
    If varSaveAsTxt = False Then Exit Sub
   
    Dim fso As Object
    Set fso = CreateObject("Scripting.FileSystemObject")
    Dim oFile As Object
    Set oFile = fso.CreateTextFile(varSaveAsTxt)
    Dim cell As Object
   
    ' Go through each selected cell and write it
    For Each cell In Selection
        If Split(cell.Address, "$")(2) > intRow Then
            oFile.writeline strLine
            intRow = intRow + 1
            strLine = cell.Value
        ElseIf booFirstCell Then
            strLine = cell.Value
            booFirstCell = False
        Else
            strLine = strLine & Chr(9) & cell.Value
        End If
    Next cell
    oFile.writeline strLine
    oFile.Close
    Set fso = Nothing
    Set oFile = Nothing
End Sub

I've tested it and it seems to handle things well. Give it a go.

@kennypete
your above code is awesome, i was searching for the same solution for my needs. Above code is working fine , i just changed the codename of the sheet1 to matched my one. But instead of saving TEXT to a file , is it possible to just copy the range as Text on clipboard in same format as it shows in TXT file , so it can be pasted anywhere which required plain text .

Furthermore , can you help me to step by step to create a button on my main sheet which can trigger this macro and selected range will get copied to clipboard as text and ready to be pasted.

 

[spycein]

Sorry, no, I don't get it. How are you to know what range on Sheet 1 to output? You say:
"Could you please help to copy the data from more than once Column i.e. say Column "A to D" and CONCATENATE the value in a single line and save it as xml file.
For example if the value in Column A is 1A, Column B is 2A, Column C is 3A, Column D is 4A etc.. then my output result would be 1A2A3A4A."
...but not how you know you want A to D (rather than say A to G or just A and B)

Dear @kennypete, really sorry for the confusion. The column names mentioned are just for the reference purpose as an example.
What i actually need to copy the data from Sheet 1 column A to Column L and save it as a xml file.
Hope this is helpful to understand the requirement.
Best Regards,

 

[kennypete]

@kennypete
your above code is awesome, i was searching for the same solution for my needs. Above code is working fine , i just changed the codename of the sheet1 to matched my one. But instead of saving TEXT to a file , is it possible to just copy the range as Text on clipboard in same format as it shows in TXT file , so it can be pasted anywhere which required plain text .

Furthermore , can you help me to step by step to create a button on my main sheet which can trigger this macro and selected range will get copied to clipboard as text and ready to be pasted.

Okay, so I'm not sure that forking this to a separate thing is necessarily allowed, but since it is quite a short answer regarding the clipboard and selecting a range, here it is (code pared right back to the new use case):

Sub SelectedRangeToClipboard()
    rngSelected = Selection.Address
    For Each c In Range(rngSelected)
        strAll = strAll & c.Value
    Next c
    CreateObject("htmlfile").parentWindow.clipboardData.setData "text", strAll
End Sub

There are really complicated ways to copy to the clipboard, this and this, are sources examples, but this way (from the first link) seems the simplest.

Adding the macro to a button should be as simple as creating a new button:

Right clicking it, changing the text and assigning the macro to it

Here it is working...

 

[kennypete]

Dear @kennypete, really sorry for the confusion. The column names mentioned are just for the reference purpose as an example.
What i actually need to copy the data from Sheet 1 column A to Column L and save it as a xml file.
Hope this is helpful to understand the requirement.
Best Regards,

Okay @spycein, I have done this now going back to the earlier code and adjusting it to:

• Change the TXT to XML since that seems to be what you want
• Use the CurrentRegion of the cell A1 in Sheet1. This should pick up all of the cells from A-L columns and all of the contiguous content providing Column M is empty and you want all of the cells in columns A-L, which I infer you do, i.e. "copy the data from Sheet 1 column A to Column L"
• Added some xml tags to make the output easier to read ("1A2A3A4A" wasn't) and openable with a browser, which I show below. If you don't want the tags, it should be easy for you to remove those from the code...

Sub Sheet1CurrentRegionToXML()
    Dim strStartingSheet As String
    Dim lngRow As Long
    Dim varSaveAsXML As Variant
    Dim rngA As Range
    Dim strRangeXML As String
     
    strStartingSheet = ActiveSheet.Name
    ' Turn off showing the screen
    Application.ScreenUpdating = False
    
    ' NB: Hardcoded to "Sheet1" tab as requested!
    Sheets("Sheet1").Visible = True
    Sheets("Sheet1").Select
    ' Now using CurrentRegion
    Set rngA = Range("A1").CurrentRegion
    
    ' Reselect the starting sheet before rehiding Sheet1
    Sheets(strStartingSheet).Select
    Sheets("Sheet1").Visible = False
    
    ' Turn on showing the screen
    Application.ScreenUpdating = True
    
    varSaveAsXML = Application.GetSaveAsFilename(FileFilter:="XML (XML data) (*.xml), *.xml")
    If varSaveAsXML = False Then Exit Sub
    
    Dim fso As Object
    Set fso = CreateObject("Scripting.FileSystemObject")
    Dim oFile As Object
    Set oFile = fso.CreateTextFile(varSaveAsXML)
    
    lngRow = 1
    oFile.writeline "<?xml version=""1.0""?>"
    oFile.writeline "<xml>"
    strRangeXML = "<row>"
    Dim rngCell As Range
    For Each rngCell In rngA
        If CInt(Split(rngCell.Address, "$")(2)) <> lngRow Then
            strRangeXML = strRangeXML & "</row>"
            lngRow = CInt(Split(rngCell.Address, "$")(2))
            oFile.writeline strRangeXML
            strRangeXML = "<row>"
        End If
        strRangeXML = strRangeXML & "<c>" & rngCell.Value & "</c>"
    Next rngCell
    oFile.writeline "</xml>"
    
    oFile.Close
    Set fso = Nothing
    Set oFile = Nothing

End Sub

My Sheet1 looks like this:

And the output to the XML file, with a Chromium browser:

And @bobby786 you may want to blend this approach with the solution I provided you above for adding the tags to the pasted selected region.

 

[bobby786]

Okay, so I'm not sure that forking this to a separate thing is necessarily allowed, but since it is quite a short answer regarding the clipboard and selecting a range, here it is (code pared right back to the new use case):

Sub SelectedRangeToClipboard()
    rngSelected = Selection.Address
    For Each c In Range(rngSelected)
        strAll = strAll & c.Value
    Next c
    CreateObject("htmlfile").parentWindow.clipboardData.setData "text", strAll
End Sub

There are really complicated ways to copy to the clipboard, this and this, are sources examples, but this way (from the first link) seems the simplest.

Adding the macro to a button should be as simple as creating a new button:
View attachment 36419 Right clicking it, changing the text and assigning the macro to it View attachment 36420

Here it is working...
View attachment 36421

I thought the issue is quite similar so i posted instead of making a new thread , sorry if it make you upset.

Thanks a lot for solution.
only thing the copied text is not delimited format like it was in your first code.
right now if i copy the text from excel to notepad it show me results like below without using macro , that's how i required it


ORD#1 40,000 S-30
ORD#1 40,000 S-33
ORD#1 20,000 PACE-100


from the below sheet data

ORD#1	40,000	S-30
ORD#1	40,000	S-33
ORD#1	20,000	PACE-100

using macro i get the result like below to be exact.

ORD#140000S-30ORD#140000S-33ORD#120000PACE-100

 

[kennypete]

I thought the issue is quite similar so i posted instead of making a new thread , sorry if it make you upset.

Thanks a lot for solution.
only thing the copied text is not delimited format like it was in your first code.
right now if i copy the text from excel to notepad it show me results like below without using macro , that's how i required it


ORD#1 40,000 S-30
ORD#1 40,000 S-33
ORD#1 20,000 PACE-100


from the below sheet data

ORD#1	40,000	S-30
ORD#1	40,000	S-33
ORD#1	20,000	PACE-100

using macro i get the result like below to be exact.

ORD#140000S-30ORD#140000S-33ORD#120000PACE-100

There's been so many variants on the moving target that has been this thread @bobby786 I've lost count. In one of the prior posts I'd said you could blend the approaches together. Here's the tab delimited range selection paste modified/blended, with the main addition being ensuring that it can handle the range not starting at cell A1:

Sub SelectedRangeToClipboardTabs()
    rngSelected = Selection.Address
    'Column of first cell in the range
    lngCol = Split(Selection.Address, "$")(1)
    'Row of first cell in the range
    lngRow = Split(Split(Selection.Address, "$")(2), ":")(0)
    For Each c In Range(rngSelected)
        If CInt(Split(c.Address, "$")(2)) <> lngRow Then
            strAll = strAll & vbCrLf & c.Value
            lngRow = CInt(Split(c.Address, "$")(2))
        Else
            If Split(c.Address, "$")(1) = lngCol Then
                strAll = strAll & c.Value
            Else
                strAll = strAll & Chr(9) & c.Value
            End If
        End If
    Next c
    CreateObject("htmlfile").parentWindow.clipboardData.setData "text", strAll
End Sub

So that's with tabs delimiting (Chr(9)).
And in case the XML selection option is wanted I thought that may as well be thrown in too:

Sub SelectedRangeToClipboardXML()
    rngSelected = Selection.Address
    'Column of first cell in the range
    lngCol = Split(Selection.Address, "$")(1)
    'Row of first cell in the range
    lngRow = Split(Split(Selection.Address, "$")(2), ":")(0)
    strAll = "<?xml version=""1.0""?>" & vbCrLf & "<xml>" & vbCrLf
    For Each c In Range(rngSelected)
        If CInt(Split(c.Address, "$")(2)) <> lngRow Then
            strAll = strAll & "</row>" & vbCrLf & "<row><c>" & c.Value & "</c>"
            lngRow = CInt(Split(c.Address, "$")(2))
        Else
            If Split(c.Address, "$")(1) = lngCol Then
                strAll = strAll & "<row>" & "<c>" & c.Value & "</c>"
            Else
                strAll = strAll & "<c>" & c.Value & "</c>"
            End If
        End If
    Next c
    strAll = strAll & "</row>" & vbCrLf & "</xml>"
    CreateObject("htmlfile").parentWindow.clipboardData.setData "text", strAll
End Sub

Using your data and assigning to the button respectively, the outputs:

 

[bobby786]

There's been so many variants on the moving target that has been this thread @bobby786 I've lost count. In one of the prior posts I'd said you could blend the approaches together. Here's the tab delimited range selection paste modified/blended, with the main addition being ensuring that it can handle the range not starting at cell A1:

Sub SelectedRangeToClipboardTabs()
    rngSelected = Selection.Address
    'Column of first cell in the range
    lngCol = Split(Selection.Address, "$")(1)
    'Row of first cell in the range
    lngRow = Split(Split(Selection.Address, "$")(2), ":")(0)
    For Each c In Range(rngSelected)
        If CInt(Split(c.Address, "$")(2)) <> lngRow Then
            strAll = strAll & vbCrLf & c.Value
            lngRow = CInt(Split(c.Address, "$")(2))
        Else
            If Split(c.Address, "$")(1) = lngCol Then
                strAll = strAll & c.Value
            Else
                strAll = strAll & Chr(9) & c.Value
            End If
        End If
    Next c
    CreateObject("htmlfile").parentWindow.clipboardData.setData "text", strAll
End Sub

So that's with tabs delimiting (Chr(9)).
And in case the XML selection option is wanted I thought that may as well be thrown in too:

Sub SelectedRangeToClipboardXML()
    rngSelected = Selection.Address
    'Column of first cell in the range
    lngCol = Split(Selection.Address, "$")(1)
    'Row of first cell in the range
    lngRow = Split(Split(Selection.Address, "$")(2), ":")(0)
    strAll = "<?xml version=""1.0""?>" & vbCrLf & "<xml>" & vbCrLf
    For Each c In Range(rngSelected)
        If CInt(Split(c.Address, "$")(2)) <> lngRow Then
            strAll = strAll & "</row>" & vbCrLf & "<row><c>" & c.Value & "</c>"
            lngRow = CInt(Split(c.Address, "$")(2))
        Else
            If Split(c.Address, "$")(1) = lngCol Then
                strAll = strAll & "<row>" & "<c>" & c.Value & "</c>"
            Else
                strAll = strAll & "<c>" & c.Value & "</c>"
            End If
        End If
    Next c
    strAll = strAll & "</row>" & vbCrLf & "</xml>"
    CreateObject("htmlfile").parentWindow.clipboardData.setData "text", strAll
End Sub

Using your data and assigning to the button respectively, the outputs:
View attachment 36433

I cannot you thank you enough man , you are hero for excel. I am using the one without XML , and it works like charm .

 

[spycein]

Okay @spycein, I have done this now going back to the earlier code and adjusting it to:

• Change the TXT to XML since that seems to be what you want
• Use the CurrentRegion of the cell A1 in Sheet1. This should pick up all of the cells from A-L columns and all of the contiguous content providing Column M is empty and you want all of the cells in columns A-L, which I infer you do, i.e. "copy the data from Sheet 1 column A to Column L"
• Added some xml tags to make the output easier to read ("1A2A3A4A" wasn't) and openable with a browser, which I show below. If you don't want the tags, it should be easy for you to remove those from the code...

Sub Sheet1CurrentRegionToXML()
    Dim strStartingSheet As String
    Dim lngRow As Long
    Dim varSaveAsXML As Variant
    Dim rngA As Range
    Dim strRangeXML As String
   
    strStartingSheet = ActiveSheet.Name
    ' Turn off showing the screen
    Application.ScreenUpdating = False
  
    ' NB: Hardcoded to "Sheet1" tab as requested!
    Sheets("Sheet1").Visible = True
    Sheets("Sheet1").Select
    ' Now using CurrentRegion
    Set rngA = Range("A1").CurrentRegion
  
    ' Reselect the starting sheet before rehiding Sheet1
    Sheets(strStartingSheet).Select
    Sheets("Sheet1").Visible = False
  
    ' Turn on showing the screen
    Application.ScreenUpdating = True
  
    varSaveAsXML = Application.GetSaveAsFilename(FileFilter:="XML (XML data) (*.xml), *.xml")
    If varSaveAsXML = False Then Exit Sub
  
    Dim fso As Object
    Set fso = CreateObject("Scripting.FileSystemObject")
    Dim oFile As Object
    Set oFile = fso.CreateTextFile(varSaveAsXML)
  
    lngRow = 1
    oFile.writeline "<?xml version=""1.0""?>"
    oFile.writeline "<xml>"
    strRangeXML = "<row>"
    Dim rngCell As Range
    For Each rngCell In rngA
        If CInt(Split(rngCell.Address, "$")(2)) <> lngRow Then
            strRangeXML = strRangeXML & "</row>"
            lngRow = CInt(Split(rngCell.Address, "$")(2))
            oFile.writeline strRangeXML
            strRangeXML = "<row>"
        End If
        strRangeXML = strRangeXML & "<c>" & rngCell.Value & "</c>"
    Next rngCell
    oFile.writeline "</xml>"
  
    oFile.Close
    Set fso = Nothing
    Set oFile = Nothing

End Sub

My Sheet1 looks like this:
View attachment 36431
And the output to the XML file, with a Chromium browser:
View attachment 36432
And @bobby786 you may want to blend this approach with the solution I provided you above for adding the tags to the pasted selected region.

Dear @kennypete, Thank you so much for your help. Cannot thank you enough for this.
One last request, i have removed the xml tags since i only save the data in xml format. The only issue which i get when i save the data is it concatenate the each row data.

Following the updated code:

Sub Sheet1CurrentRegionToXML()
Dim strStartingSheet As String
Dim lngRow As Long
Dim varSaveAsXML As Variant
Dim rngA As Range
Dim strRangeXML As String

strStartingSheet = ActiveSheet.Name
' Turn off showing the screen
Application.ScreenUpdating = False

' NB: Hardcoded to "Sheet1" tab as requested!
Sheets("Sheet1").Visible = True
Sheets("Sheet1").Select
' Now using CurrentRegion
Set rngA = Range("A1").CurrentRegion

' Reselect the starting sheet before rehiding Sheet1
Sheets(strStartingSheet).Select
Sheets("Sheet1").Visible = False

' Turn on showing the screen
Application.ScreenUpdating = True

varSaveAsXML = Application.GetSaveAsFilename(FileFilter:="XML (XML data) (*.xml), *.xml")
If varSaveAsXML = False Then Exit Sub

Dim fso As Object
Set fso = CreateObject("Scripting.FileSystemObject")
Dim oFile As Object
Set oFile = fso.CreateTextFile(varSaveAsXML)

Dim rngCell As Range
For Each rngCell In rngA
If CInt(Split(rngCell.Address, "$")(2)) <> lngRow Then
strRangeXML = strRangeXML
lngRow = CInt(Split(rngCell.Address, "$")(2))
oFile.writeline strRangeXML
End If
strRangeXML = strRangeXML & rngCell.Value
Next rngCell
oFile.writeline

oFile.Close
Set fso = Nothing
Set oFile = Nothing

End Sub


and the result which i get from the above code is as follows:

But the result of the output data which i am looking is as follows

13565981022ssGGMMOOSHIB
13565981022ssGGMMOOSHIB
13565981022ssGGMMOOSHIB
13565981022ssGGMMOOSHIB
13565981022ssGGMMOOSHIB
13565981022ssGGMMOOSHIB
13565981022ssGGMMOOSHIB
13565981022ssGGMMOOSHIB
13565981022ssGGMMOOSHIB

Many thanks once again
Best Regards,

 

[spycein]

Dear @kennypete, Thank you so much for your help. Cannot thank you enough for this.
One last request, i have removed the xml tags since i only save the data in xml format. The only issue which i get when i save the data is it concatenate the each row data.

Following the updated code:

Sub Sheet1CurrentRegionToXML()
Dim strStartingSheet As String
Dim lngRow As Long
Dim varSaveAsXML As Variant
Dim rngA As Range
Dim strRangeXML As String

strStartingSheet = ActiveSheet.Name
' Turn off showing the screen
Application.ScreenUpdating = False

' NB: Hardcoded to "Sheet1" tab as requested!
Sheets("Sheet1").Visible = True
Sheets("Sheet1").Select
' Now using CurrentRegion
Set rngA = Range("A1").CurrentRegion

' Reselect the starting sheet before rehiding Sheet1
Sheets(strStartingSheet).Select
Sheets("Sheet1").Visible = False

' Turn on showing the screen
Application.ScreenUpdating = True

varSaveAsXML = Application.GetSaveAsFilename(FileFilter:="XML (XML data) (*.xml), *.xml")
If varSaveAsXML = False Then Exit Sub

Dim fso As Object
Set fso = CreateObject("Scripting.FileSystemObject")
Dim oFile As Object
Set oFile = fso.CreateTextFile(varSaveAsXML)

Dim rngCell As Range
For Each rngCell In rngA
If CInt(Split(rngCell.Address, "$")(2)) <> lngRow Then
strRangeXML = strRangeXML
lngRow = CInt(Split(rngCell.Address, "$")(2))
oFile.writeline strRangeXML
End If
strRangeXML = strRangeXML & rngCell.Value
Next rngCell
oFile.writeline

oFile.Close
Set fso = Nothing
Set oFile = Nothing

End Sub


and the result which i get from the above code is as follows:

View attachment 36440


But the result of the output data which i am looking is as follows

13565981022ssGGMMOOSHIB
13565981022ssGGMMOOSHIB
13565981022ssGGMMOOSHIB
13565981022ssGGMMOOSHIB
13565981022ssGGMMOOSHIB
13565981022ssGGMMOOSHIB
13565981022ssGGMMOOSHIB
13565981022ssGGMMOOSHIB
13565981022ssGGMMOOSHIB

Many thanks once again
Best Regards,

Forgot to attach my source data sample which i need to save as xml format file

 

[kennypete]

Dear @kennypete, Thank you so much for your help. Cannot thank you enough for this.
One last request, i have removed the xml tags since i only save the data in xml format. The only issue which i get when i save the data is it concatenate the each row data.

Following the updated code:

Sub Sheet1CurrentRegionToXML()
Dim strStartingSheet As String
Dim lngRow As Long
Dim varSaveAsXML As Variant
Dim rngA As Range
Dim strRangeXML As String

strStartingSheet = ActiveSheet.Name
' Turn off showing the screen
Application.ScreenUpdating = False

' NB: Hardcoded to "Sheet1" tab as requested!
Sheets("Sheet1").Visible = True
Sheets("Sheet1").Select
' Now using CurrentRegion
Set rngA = Range("A1").CurrentRegion

' Reselect the starting sheet before rehiding Sheet1
Sheets(strStartingSheet).Select
Sheets("Sheet1").Visible = False

' Turn on showing the screen
Application.ScreenUpdating = True

varSaveAsXML = Application.GetSaveAsFilename(FileFilter:="XML (XML data) (*.xml), *.xml")
If varSaveAsXML = False Then Exit Sub

Dim fso As Object
Set fso = CreateObject("Scripting.FileSystemObject")
Dim oFile As Object
Set oFile = fso.CreateTextFile(varSaveAsXML)

Dim rngCell As Range
For Each rngCell In rngA
If CInt(Split(rngCell.Address, "$")(2)) <> lngRow Then
strRangeXML = strRangeXML
lngRow = CInt(Split(rngCell.Address, "$")(2))
oFile.writeline strRangeXML
End If
strRangeXML = strRangeXML & rngCell.Value
Next rngCell
oFile.writeline

oFile.Close
Set fso = Nothing
Set oFile = Nothing

End Sub


and the result which i get from the above code is as follows:

View attachment 36440


But the result of the output data which i am looking is as follows

13565981022ssGGMMOOSHIB
13565981022ssGGMMOOSHIB
13565981022ssGGMMOOSHIB
13565981022ssGGMMOOSHIB
13565981022ssGGMMOOSHIB
13565981022ssGGMMOOSHIB
13565981022ssGGMMOOSHIB
13565981022ssGGMMOOSHIB
13565981022ssGGMMOOSHIB

Many thanks once again
Best Regards,

The following should do what you are after. The main thing that needed change was to reset strRangeXML to "" at each new 'row'.

Sub Sheet1CurrentRegionToXML2()
' XML2 solution
    
    Dim strStartingSheet As String
    Dim lngRow As Long
    Dim varSaveAsXML As Variant
    Dim rngA As Range
    Dim strRangeXML As String
     
    strStartingSheet = ActiveSheet.Name
    ' Turn off showing the screen
    Application.ScreenUpdating = False
    
    ' NB: Hardcoded to "Sheet1" tab as requested!
    Sheets("Sheet1").Visible = True
    Sheets("Sheet1").Select
    ' Now using CurrentRegion
    Set rngA = Range("A1").CurrentRegion
    
    ' Reselect the starting sheet before rehiding Sheet1
    Sheets(strStartingSheet).Select
    Sheets("Sheet1").Visible = False
    
    ' Turn on showing the screen
    Application.ScreenUpdating = True
    
    varSaveAsXML = Application.GetSaveAsFilename(FileFilter:="XML (XML data) (*.xml), *.xml")
    If varSaveAsXML = False Then Exit Sub
    
    Dim fso As Object
    Set fso = CreateObject("Scripting.FileSystemObject")
    Dim oFile As Object
    Set oFile = fso.CreateTextFile(varSaveAsXML)
    
    lngRow = 1
    Dim rngCell As Range
    For Each rngCell In rngA
        If CInt(Split(rngCell.Address, "$")(2)) <> lngRow Then
            lngRow = CInt(Split(rngCell.Address, "$")(2))
            ' Write the row and reset the strRangeXML variable
            oFile.writeline strRangeXML
            strRangeXML = ""
        End If
        strRangeXML = strRangeXML & rngCell.Value
    Next rngCell
    ' Write the last row
    oFile.writeline strRangeXML
    
    oFile.Close
    Set fso = Nothing
    Set oFile = Nothing

End Sub

Note it's hard to debug when all of your rows' data are identical. I tried it on my non-repetitive data and it works fine. Incidentally, I find it strange that all you are doing is saving the file as non-delimited text only, which is not XML. No matter, hopefully this closes this thread out finally.

I recommend in future posts you make it much clearer what you're trying to achieve overall + provide good source data examples to work with up front because this has been a very incremental thread, inching towards the final solution as the scope and requirements evolved. Take care.