Hente data fra fil2 ind i fil1

Via VBA skulle det nok kunne lade sig gøre.

Ja, men kan du hjælpe ?

Ja - vil godt gøre et forsøg.

Filer kan evt. sendes direkte - @-adresse under min profil.

Rem Fælles
Const startRække = 2
Dim aktuelleSti As String

Rem MedlemsData
Const startKolonneKontaktPersoner = 25
Dim sidsterække As Long, ræk As Long
Dim medlemsNr As Long
Dim arkM As Worksheet, rM As Range

Rem KontaktPersoner
Const kontaktPersonerFilNavn = "kontaktPersoner.xlsx"
Dim kontaktXLS As Object
Dim arkK As Worksheet
Dim antalKrækker As Long, antalKkolonner As Long, rK As Range
Public Sub hentKontaktPersoner()
On Error GoTo lukKontaktPersoner

    Application.ScreenUpdating = False
   
    aktuelleSti = opbygAktuelleSti
   
    aktiverKontaktPersoner
    aktiverMedlemsArk
   
    sidsterække = ActiveCell.SpecialCells(xlLastCell).Row
   
    For ræk = startRække To sidsterække
        medlemsNr = Range("S" & ræk)
        findKontaktPersoner medlemsNr, ræk
   
    Next ræk
     
    Application.ScreenUpdating = True
    MsgBox "Kørsel afsluttet"
   
lukKontaktPersoner:
    kontaktXLS.Application.Quit
    Set kontaktXLS = Nothing
   
    Set arkM = Nothing
End Sub
Private Function opbygAktuelleSti()
Dim sti As String
    sti = ThisWorkbook.Path
   
    If Right(sti, 1) <> "\" Then
        sti = sti & "\"
    End If
   
    opbygAktuelleSti = sti
End Function
Private Sub aktiverKontaktPersoner()
    Set kontaktXLS = CreateObject("Excel.Application")
    kontaktXLS.Workbooks.Open aktuelleSti & kontaktPersonerFilNavn

Rem Test
Rem    kontaktXLS.Visible = True

    Set arkK = kontaktXLS.Sheets(1)
    antalKrækker = kontaktXLS.ActiveCell.SpecialCells(xlLastCell).Row
    antalKkolonner = kontaktXLS.ActiveCell.SpecialCells(xlLastCell).Column
   
End Sub
Private Sub aktiverMedlemsArk()
    Set arkM = ActiveWorkbook.Sheets(1)
End Sub
Private Sub findKontaktPersoner(medlemsNr, ræk)
Dim Kræk As Long, antalMatch As Integer
    antalMatch = 0
    For Kræk = startRække To antalKrækker
        If arkK.Range("A" & Kræk) = medlemsNr Then
            antalMatch = antalMatch + 1
            Set rK = arkK.Range(arkK.Cells(Kræk, 1), arkK.Cells(Kræk, antalKkolonner))
            Set rM = arkM.Cells(ræk, 1).Offset(0, ((antalMatch - 1) * antalKkolonner) + startKolonneKontaktPersoner)
                       
            indsætkontaktpersoner rK, rM
        End If
    Next Kræk
End Sub
Private Sub indsætkontaktpersoner(rK As Range, rM As Range)
    rK.Select
    rK.Copy
   
    ActiveWorkbook.Activate
    rM.Select
    ActiveSheet.Paste
   
    Application.CutCopyMode = False
End Sub