Versuchs mal damit. Eventuell mußt Du die Quell- und/oder Zielkoordinaten noch anpassen, aber sonst sollte es gehen:

Option Explicit
Sub Daten_importieren()
Dim filSRC As Excel.Workbook
Dim strSRC As String
Dim shtTRG As Excel.Worksheet
Dim rngSearch As Excel.Range
Dim rngZelle As Excel.Range
Dim lngFreieZeile As Long
Dim bolExist As Boolean
On Error Resume Next
Application.ScreenUpdating = False
Application.EnableEvents = False
Set shtTRG = ThisWorkbook.Sheets("Sheet1")
With shtTRG
    lngFreieZeile = .Cells(.Cells.Rows.Count, 2).End(xlUp).Row + 1
    strSRC = Application.GetOpenFilename("Excel-Arbeitsmappe (*.xls),*.xls,Excel2007-Arbeitsmappe (*.xlsx),*.xlsx", 1, "Importdatei auswählen...", "Importdatei", False)
    If strSRC = "" Or strSRC = "Falsch" Then
        Set shtTRG = Nothing
        Application.ScreenUpdating = True
        Application.EnableEvents = True
        Exit Sub
    End If
    Set filSRC = Application.Workbooks.Open(strSRC, , True): DoEvents
    Set rngSearch = .Range("B1:" & CStr(lngFreieZeile - 1))
    bolExist = False
    For Each rngZelle In rngSearch
        If rngZelle = filSRC.Sheets(1).Range("B1") Then
            rngZelle.EntireRow.Columns("A") = filSRC.Sheets(1).Range("A1")
            rngZelle.EntireRow.Columns("B") = filSRC.Sheets(1).Range("B1")
            rngZelle.EntireRow.Columns("C") = filSRC.Sheets(1).Range("C1")
            rngZelle.EntireRow.Columns("D") = filSRC.Sheets(1).Range("D1")
            bolExist = True
            Exit Do
        End If
    Next
    If bolExist = False Then
        .Cells(lngFreieZeile, "A") = filSRC.Sheets(1).Range("A1")
        .Cells(lngFreieZeile, "B") = filSRC.Sheets(1).Range("B1")
        .Cells(lngFreieZeile, "C") = filSRC.Sheets(1).Range("C1")
        .Cells(lngFreieZeile, "D") = filSRC.Sheets(1).Range("D1")
    End If
    filSRC.Close False
    Set filSRC = Nothing
    Set rngSearch = Nothing
End With
Set shtTRG = Nothing
Application.ScreenUpdating = True
Application.EnableEvents = True
End Sub