Sub main()
Dim wkb As Excel.Workbook
Dim wks As Excel.Worksheet
Dim rngQuelle As Excel.Range
Dim rngToCopy As Excel.Range
Dim sTxt As String
Set wks = ThisWorkbook.Worksheets(1)
Set wkb = Application.Workbooks("Errechnung Dehnung_Schrumpfung.xls")
sTxt = InputBox("Teilenummer:")
If sTxt = "" Then Exit Sub
With wks
If .AutoFilterMode Then .AutoFilterMode = False
Set rngQuelle = .Range("A1").CurrentRegion
rngQuelle.AutoFilter Field:=3, Criteria1:=sTxt
Set rngQuelle = Intersect( _
rngQuelle, _
rngQuelle.SpecialCells(xlCellTypeVisible), _
rngQuelle.Columns("A:C"))
If Not rngQuelle Is Nothing Then
With rngQuelle
.Copy Destination:=wkb.Worksheets(1).Range("E7")
End With
End If
End With
End Sub