Makro formel virker ikke i nyt regneark.

Hej jeg har en makro kode som virker perfekt! men når jeg overføre denne gode til et andet regneark, så virker den ikke mere, kan ikke finde ud af hvad der går galt.

Her er koden, håber der er nogen som kan hjælpe :)

Dim produkt As Object

Const dataSamlerSti = "F:\Regnskab\Statusark\"              '<---- tilpasses
Const dataSamlerFilNavn = "Statusliste regnskabsgruppen 2016.xlsm"                                        '<---- - " -
Const dataSamlerArkNavn = "Budgetopfølgning"                                              '<---- - " -
Dim dataSamler As Object
Private Sub CommandButton1_Click()
Dim produktId, rækDs As Integer
    Set produkt = ActiveWorkbook
   
    produktId = Range("B5")
   
    Set dataSamler = CreateObject("Excel.Application")
    dataSamler.Workbooks.Open dataSamlerSti & dataSamlerFilNavn
   
    rækDs = findRækkeDataSamler(produktId)
    If rækDs > 0 Then
        kopierData rækDs
        dataSamler.ActiveWorkbook.Save
    Else
        MsgBox "ProduktId ikke fundet"
    End If
       
    dataSamler.Quit
    Set dataSamler = Nothing
End Sub
Private Function findRækkeDataSamler(produktId)
Dim antalRækker As Integer
    antalRækker = dataSamler.ActiveCell.SpecialCells(xlLastCell).Row
   
    With dataSamler.Sheets(dataSamlerArkNavn)
        dataSamler.Sheets(dataSamlerArkNavn).Activate
       
        For Each CC In .Range("B5:B" & antalRækker)
            If produktId = CC Then
                findRækkeDataSamler = CC.Row
                Exit Function
            End If
        Next CC
    End With
    findRækkeDataSamler = 0
End Function
Private Sub kopierData(rækDs)
    With dataSamler.Sheets(dataSamlerArkNavn)
        .Range("J" & rækDs) = produkt.Sheets(1).Range("Udsendt_budgopf2")
        .Range("K" & rækDs) = produkt.Sheets(1).Range("resultat_budgopf2")
        .Range("L" & rækDs) = produkt.Sheets(1).Range("SvarDato_budgopf2")
        .Range("M" & rækDs) = produkt.Sheets(1).Range("rykkerbrev1_budgopf2")
        .Range("N" & rækDs) = produkt.Sheets(1).Range("rykkerbrev2_budgopf2")
        .Range("O" & rækDs) = produkt.Sheets(1).Range("kodefelt_budgopf2")
        .Range("AB" & rækDs) = produkt.Sheets(1).Range("makker_budgopf2")
        .Range("AD" & rækDs) = produkt.Sheets(1).Range("D70")
       
        MsgBox "Data er overført"
       
    End With
End Sub

Mvh
TheresaD