Option Explicit
Sub ExportToXML()
Dim Filename As Variant
Dim Rng As Range
Dim r As Long, c As Long
' Set the range
Set Rng = Range("Table1[#All]")
' Get a file name
Filename = Application.GetSaveAsFilename( _
InitialFileName:="myrange.xml", _
fileFilter:="XML Files(*.xml), *.xml")
If Filename = False Then Exit Sub
' Open the text file
Open Filename For Output As #1
' Write the tags
Print #1, ""
Print #1, ""
' Loop through the cells
For r = 2 To Rng.Rows.Count
Print #1, ""
For c = 1 To Rng.Columns.Count
Print #1, "<" & Rng.Cells(1, c) & ">";
If IsDate(Rng.Cells(r, c)) Then
Print #1, Format(Rng.Cells(r, c), "yyyy-mm-dd");
Else
Print #1, Rng.Cells(r, c).Text;
End If
Print #1, "" & Rng.Cells(1, c) & ">"
Next c
Print #1, ""
Next r
' Close the table
Print #1, ""
' Close the file
Close #1
' Tell the user
MsgBox Rng.Rows.Count - 1 & " records were exported to " & Filename
End Sub