簡易 テーブル→xml変換

Sub Main()

    Dim sh As Worksheet
    Set sh = Sheets("シート名")

    Dim i As Integer
    Dim j As Integer
    i = 2
    j = 1
    
    Do While sh.Cells(i, 1) <> ""
        Dim line As String
        Dim header As String
        Dim v As String
        j = 2

        line = "<record>" & vbCrLf
        Do While sh.Cells(1, j) <> ""
            header = sh.Cells(1, j)
            v = sh.Cells(i, j)
            line = line & "  " & "<" & header & ">" & v & "</" & header & ">" & vbCrLf
            j = j + 1
        Loop
        line = line & "</record>" & vbCrLf

        i = i + 1

        OutputFile (line)

    Loop

End Sub

Sub OutputFile(str As String)

    Dim intFF As Integer
    intFF = FreeFile

    Open "path\to\data.xml" For Append As #intFF
    Print #intFF, str;
    Close #intFF

End Sub