Sub Schaltfläche1_Klicken()
Dim wdApp As Object
Dim wdDoc As Object
Dim sFile As String
Dim fdDialog As FileDialog
Set fdDialog = Application.FileDialog(msoFileDialogFilePicker)
With fdDialog
.Filters.Clear
.Filters.Add "RTF-Dateien", "*.rtf", 1
If .Show = -1 Then
sFile = .SelectedItems(1)
Set wdApp = CreateObject("Word.Application")
wdApp.Visible = True
Set wdDoc = wdApp.Documents.Open(sFile)
wdApp.activedocument.Tables(2).Select
wdApp.Selection.Copy
Worksheets.Add
ActiveSheet.Paste
wdApp.Quit
Set wdDoc = Nothing
Set wdApp = Nothing
Range("A2:A" & ActiveSheet.UsedRange.Rows.Count & "").Select
Selection.Copy
Worksheets("Ziel").Select
Range("A7").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Worksheets(1).Select
Range("B2:B" & ActiveSheet.UsedRange.Rows.Count & "").Select
Selection.Copy
Worksheets("Ziel").Select
Range("B7").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Worksheets(1).Select
Range("C2:C" & ActiveSheet.UsedRange.Rows.Count & "").Select
Selection.Copy
Worksheets("Ziel").Select
Range("D7").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.DisplayAlerts = False
Worksheets(1).Delete
Application.DisplayAlerts = True
End If
End With
Set fdDialog = Nothing
End Sub