... natürlich etwas umgeschrieben.

Luke, so zielstrebig wie Du bist - das kenne ich - das schätze ich - möchte Ich unterstützen. Behalte den Elan, aber beginne Deine Ziele durch Eigenleistung zu erreichen. Wenn es VBA dazu braucht, dann fang an zu lesen.

In diesem Sinner:

Folgendes schreibst Du in eine neue XLSM-Mappe; in ein allgemeines Modul. In demselben Ordner befinden sich Deine einzulesenden XML-Dateien.

Wenn Du das hast -> main() ausführen:

Option Explicit

    Const m_sVehicleIdentificationNumber As String = "VehicleIdentificationNumber"
    Const m_sTypeApprovalNumber As String = "TypeApprovalNumber"
    Const m_sTechnicallyPermMassAxle As String = "TechnicallyPermMassAxle"
    Const m_sTechPermMassAxleGroup As String = "TechPermMassAxleGroup"

Sub main()
    Dim sXMLFileName As String
    sXMLFileName = Dir(ThisWorkbook.Path & Application.PathSeparator & "*.xml")
    'jede XML im selben Ordner wie diese XLSM einlesen und verarbeiten
    While sXMLFileName <> ""
        Call XmlZugriffViaXPathAufCollection(ThisWorkbook.Path & Application.PathSeparator & sXMLFileName)
        sXMLFileName = Dir()
    Wend
    '
End Sub

Sub XmlZugriffViaXPathAufCollection(ByVal sXmlPfad As String)
    Dim wks As Excel.Worksheet
    Dim arr(3) As String
    Dim xmlDoc As Object
    Dim xmlNode As Object
    Dim i As Byte
    'LateBindeing Objektreferenz
    Set xmlDoc = CreateObject(class:="MSXML2.DomDocument")
    'Minimale Fehlerbehandlung
    On Error GoTo FinishErr
    'neues Arbeitsblatt für XML-Import benennen
    Set wks = ThisWorkbook.Worksheets.Add
    wks.Name = "ImportXML"
    'XML parsen/laden
    Call xmlDoc.Load(sXmlPfad)
    xmlDoc.validateOnParse = True
    xmlDoc.setProperty "SelectionLanguage", "XPath"
    'arrString für Node-Collection
    arr(0) = "/InitialVehicleInformation/Body/DataGroup/VehicleIdentificationNumber"
    arr(1) = "/InitialVehicleInformation/Body/DataGroup/TypeApprovalNumber"
    arr(2) = "/InitialVehicleInformation/Body/DataGroup/AxleTable/AxleGroup/TechnicallyPermMassAxle"
    arr(3) = "/InitialVehicleInformation/Body/DataGroup/AxleGroupTable/AxleGroupGroup/TechPermMassAxleGroup"
    'durch Nodes schleifen und die Werte im neuen Arbeitsblatt hinterlegen
    For i = LBound(arr) To UBound(arr)
        For Each xmlNode In xmlDoc.SelectNodes(arr(i))
            Debug.Print xmlNode.nodeName
            Select Case xmlNode.nodeName
                Case Is = m_sVehicleIdentificationNumber
                    Call setValueInWorksheet(wks, m_sVehicleIdentificationNumber, xmlNode.Text)
                Case Is = m_sTypeApprovalNumber
                    Call setValueInWorksheet(wks, m_sTypeApprovalNumber, xmlNode.Text)
                Case Is = m_sTechnicallyPermMassAxle
                    Call setValueInWorksheet(wks, m_sTechnicallyPermMassAxle, xmlNode.Text)
                Case Is = m_sTechPermMassAxleGroup
                    Call setValueInWorksheet(wks, m_sTechPermMassAxleGroup, xmlNode.Text)
                Case Else
            End Select
        Next
    Next i
    'Überschriften im neuen Arbeitsblatt nach http://www.vba-forum.de/forum/View.aspx?ziel=59350-es_muss_nicht_VBA_sein
    Call setÜberschrift(wks)
FinishErr:
Select Case Err.Number
    Case 1004 'Falls Arbeitsblattname schon vorhanden, wks.name = Import + Rnd()
        wks.Name = "ImportXML" & wks.Name
        Resume Next
    Case Else
        'Debug.Print Err.Number; Err.Description
End Select
    'Objektreferenzen entlassen
    Set xmlNode = Nothing: Set xmlDoc = Nothing: Set wks = Nothing
End Sub

Sub setValueInWorksheet(wks As Excel.Worksheet, sNodeName As String, sWriteValue As String)
    With wks
        Select Case sNodeName
            Case Is = m_sVehicleIdentificationNumber
                .Cells(.Rows.Count, 1).End(xlUp).Offset(1).Value = sWriteValue
            Case Is = m_sTypeApprovalNumber
                .Cells(.Rows.Count, 2).End(xlUp).Offset(1).Value = sWriteValue
            Case Is = m_sTechnicallyPermMassAxle
                .Cells(.Rows.Count, 3).End(xlUp).Offset(1).Value = sWriteValue
            Case Is = m_sTechPermMassAxleGroup
                .Cells(.Rows.Count, 4).End(xlUp).Offset(1).Value = sWriteValue
        End Select
    End With
End Sub
Sub setÜberschrift(wks As Excel.Worksheet)
    With wks
        .Cells(1, 1).Value = m_sVehicleIdentificationNumber
        .Cells(1, 2).Value = m_sTypeApprovalNumber
        .Cells(1, 3).Value = m_sTechnicallyPermMassAxle
        .Cells(1, 4).Value = m_sTechPermMassAxleGroup
    End With
End Sub