Makro til eksport af data til forskellige forms

Du er velkommen til at sende filerne / model m.v.
@-adresse under min profil.

Dim tabA As Variant, tabM As Variant
Dim adrA As String, adrM As String

Const APFtabel = "E9;E10;E13;E14;E23;N9;N10;N11;N12;N14"
Const MDStabel = "A;M;N;P;L;T;H;I;O;;"
Dim APF As Workbook
Const APFilNavn = "APForm_macro_pdf - test.xlsm"
Const APFsti = "C:\Users\peter\Desktop\Eksp.NiclasMadsen\"
Const APFarkNavn = "Disposition of new supplier"

Dim sysXls As Object
Dim ræk As Integer
Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
    If Target.Column = 1 Then
        If Target <> "" Then
            Cancel = True
            ræk = Target.Row
            Set sysXls = ActiveWorkbook
            åbnAPF
            overførData
       
            APF.Save
            APF.Close
            Set APF = Nothing
           
            Set sysXls = Nothing
        End If
    End If
End Sub
Private Sub åbnAPF()
    Workbooks.Open APFsti & APFilNavn
    Set APF = ActiveWorkbook
    APF.Sheets(APFarkNavn).Activate
End Sub
Private Sub overførData()
Dim ix As Integer
    tabA = Split(APFtabel, ";")
    tabM = Split(MDStabel, ";")
   
    Application.ScreenUpdating = False
   
    For ix = 0 To UBound(tabM) - 1
        If Trim(tabM(ix)) <> "" Then
            adrM = tabM(ix) & ræk
           
            If tabA(ix) <> "" Then
                adrA = tabA(ix)
            End If
       
            With APF.ActiveSheet
                .Range(adrA).Value = sysXls.Sheets(1).Range(adrM).Value
            End With
        End If
    Next ix
End Sub

Virker perfekt, tak. Svar?

Et svar..

også god weekend til dig

Version er netop afsendt..