Könnet etwa so aussehen:

Option Explicit

Sub textdateien_uebernehmen()
Dim lngLaufZahl As Long
Dim strDateiNamen As Variant
Dim trgWB As Excel.Workbook
Dim tmpWB As Excel.Workbook
Dim trgWBName As String
Dim bslashPos As Integer
Dim shName As String


strDateiNamen = Application.GetOpenFilename("Text-Dateien(*.txt*),*.txt*", MultiSelect:=True)

If IsArray(strDateiNamen) Then
    For lngLaufZahl = LBound(strDateiNamen) To UBound(strDateiNamen)
        If lngLaufZahl = LBound(strDateiNamen) Then
            Set trgWB = Workbooks.Open(Filename:=strDateiNamen(lngLaufZahl))
            trgWB.Sheets(1).UsedRange.Select
            'Hier das Trennzeichen ggf. ändern und das Format der einzelnen Spalten als Array definieren
            Selection.TextToColumns DataType:=xlDelimited, textqualifier:=xlTextQualifierDoubleQuote, semicolon:=True
            For bslashPos = Len(strDateiNamen(lngLaufZahl)) To 1
                If Mid(strDateiNamen(lngLaufZahl), bslashPos, 1) = "\" Then Exit For
            Next bslashPos
            shName = strDateiNamen(lngLaufZahl)
            shName = Right(shName, bslashPos - 1)
            shName = Left(shName, Len(shName) - 4)
            trgWB.Sheets(1).Name = shName
            trgWBName = Application.GetSaveAsFilename(, "Excel-Arbeitsmappe (*.xls),*.xls")
            trgWB.SaveAs trgWBName, xlWorkbookNormal
        Else
            Set tmpWB = Workbooks.Open(Filename:=strDateiNamen(lngLaufZahl))
            tmpWB.Sheets(1).UsedRange.Select
            Selection.TextToColumns DataType:=xlDelimited, textqualifier:=xlTextQualifierDoubleQuote, semicolon:=True
            For bslashPos = Len(strDateiNamen(lngLaufZahl)) To 1
                If Mid(strDateiNamen(lngLaufZahl), bslashPos, 1) = "\" Then Exit For
            Next bslashPos
            shName = strDateiNamen(lngLaufZahl)
            shName = Right(shName, bslashPos - 1)
            shName = Left(shName, Len(shName) - 4)
            tmpWB.Sheets(1).Name = shName
            tmpWB.Sheets(1).Copy After:=Workbooks(trgWBName).Sheets(trgWB.Sheets.Count)
            trgWB.Save
            tmpWB.Close False
            Set tmpWB = Nothing
        End If
    Next lngLaufZahl

Else
    Set trgWB = Workbooks.Open(Filename:=strDateiNamen)
    trgWB.Sheets(1).UsedRange.Select
    Selection.TextToColumns DataType:=xlDelimited, textqualifier:=xlTextQualifierDoubleQuote, semicolon:=True
    For bslashPos = Len(strDateiNamen) To 1
        If Mid(strDateiNamen, bslashPos, 1) = "\" Then Exit For
    Next bslashPos
    shName = strDateiNamen
    shName = Right(shName, bslashPos - 1)
    shName = Left(shName, Len(shName) - 4)
    trgWB.Sheets(1).Name = shName
    trgWBName = Application.GetSaveAsFilename(, "Excel-Arbeitsmappe (*.xls),*.xls")
    trgWB.SaveAs trgWBName, xlWorkbookNormal
End If
Set trgWB = Nothing
End Sub

Severus