Sub extract()
Dim A As Integer
A = MsgBox("Overwrite existing data with new data?", vbYesNo + vbQuestion, "Import")
If A = vbYes Then
Dim x As Workbook
Dim y As Workbook
Application.ScreenUpdating = False
Set x = Workbooks.Open("C:\Users\Dateipfad\Datei.xlsx")
Set y = ThisWorkbook
y.Sheets("data").Rows("2:10000").Delete
Dim Col As Long
Col = Application.Match("Suchwert", x.Sheets("source"), Rows(1), 0)
x.Sheets("source").Cells(1, Col).Offset(1).Resize(10000).Copy_
y.Sheets("data").Range("A2").PasteSpecial xlPasteValues
x.Close SaveChanges:=False
y.Sheets("data").Cells(1, 1).Select
y.Sheets("summary").Select
Application.ScreenUpdating = True
Else
Exit Sub
End If
End Sub