gegevens uit formulier wegschrijven naar ander bestand dan waarin formulier is gemaak

[LeonieK12]

Besten,

Ik ben al enige tijd bezig met het maken van een formulier met een aantal functies. Vanaf het forum heb ik al een boel nuttige tips gehaald en nu loop ik vast. Ik heb een bestand met daarin een formulier. Op dit formulier kunnen gegevens ingevuld worden die dan naar het bestand gekopieerd worden en dit bestand wordt opgeslagen. Deze gegevens heb ik echter ook nodig in een ander bestand en wil ik het liefst vanuit het formulier rechtstreeks naar een reeds bestaand ander bestand kopieren. Ik heb al het een en ander aan code in elkaar geflanst, waarbij het bestaande bestand wordt geopend. De gegevens uit het formulier worden echter niet weggeschreven in het geopende bestaande bestand. Wellicht maak ik een denkfout, hopelijk kan iemand mij helpen. Alvast bedankt.


afdelingsoverzicht kenniskaart CNS is het bestaande te openen/vullen bestand, met als werkblad 2013. De gegevens uit het formulier worden met een druk op de knop als ander bestand opgeslagen.

Private Sub cmbGegevensAfdelingsDB_Click()

'openen werkboek afdelingsoverzicht kenniskaart CNS (= bestaande bestand, WERKT > AFDELINGSOVERZICHT OPENT NU ZICHTBAAR, ACTIVEWINDOW.VISIBLE = TRUE OMZETTEN NAAR FALSE OM NIET ZICHTBAAR TE KRIJGEN)
    Dim active As String
    Dim wb As Workbook
    
    Application.ScreenUpdating = False
    active = ActiveWorkbook.Name

        On Error Resume Next:
        Set wb = Workbooks("afdelingsoverzicht kenniskaart CNS.xlsm")
        On Error GoTo 0

        If wb Is Nothing Then
        
        Set wb = Workbooks.Open("G:\.......\afdelingsoverzicht kenniskaart CNS.xlsm")

        wb.activate
        ActiveWindow.Visible = True
        Workbooks(active).activate
        
        Else
        wb.activate
        ActiveWindow.Visible = True
        Workbooks(active).activate
        End If

        Application.ScreenUpdating = True
       
'zoeken naar 1e lege cel in werkboek afdelingsoverzicht discipline CNS 
Cells.Find(What:="", After:=Range("A2"), LookIn:=xlValues, LookAt:=xlPart, searchorder:=xlByColumns, SearchDirection:=xlNext, MatchCase:=False).activate
    
'invullen van de score op het afdelingsoverzicht discipline CNS
     With Sheets("2013") 
        ActiveCell.Offset(0, 0) = Me.cmbFunctie
        ActiveCell.Offset(0, 1) = Me.txtNaam
     End With
        
End Sub

het gaat volgens mij mis bij het selecteren/activeren van het bestand afdelingsoverzicht kenniskaart CNS en of bij de selectie van de lege cel in dit bestand. Wie o wie geeft me en zet in de goede richting

 

[LeonieK12]

oplossing gevonden

Enige tijd proberen en stap voor stap code opbouwen heeft uiteindelijk het gewenste resultaat opgeleverd (zie code).

Private Sub cmbGegevensAfdelingsDB_Click()

'openen werkboek afdelingsoverzicht kenniskaart CNS (= bestaande bestand, WERKT > AFDELINGSOVERZICHT OPENT NU ZICHTBAAR, ACTIVEWINDOW.VISIBLE = TRUE OMZETTEN NAAR FALSE OM NIET ZICHTBAAR TE KRIJGEN)
    Workbooks.Open ("G:\04_Monodisciplinary\01_Knowledge_Development\Knowledge Management\kennis in kaart\2.under construction\K.I.K. templates under construction\proefversies\CNS\afdelingsoverzicht kenniskaart CNS.xlsm")

'afdelingsoverzicht kenniskaart CNS wordt niet zichtbaar geopend
    ActiveWindow.Visible = False
        
 'zoeken naar 1e lege cel in afdelingsoverzicht discipline CNS (WERKT)
    Cells.Find(What:="", After:=Range("A2"), LookIn:=xlValues, LookAt:=xlPart, searchorder:=xlByColumns, SearchDirection:=xlNext, MatchCase:=False).activate
    
 'invullen waarden uit formulier in afdelingsoverzicht discipline CNS
     With ActiveCell
            ActiveCell.Offset(0, 0) = Me.cmbFunctie.Value
            ActiveCell.Offset(0, 1) = Me.txtNaam
            ActiveCell.Offset(0, 2) = Me.txtAppBowStern.Value
            ActiveCell.Offset(0, 3) = Me.txtStairs.Value
            ActiveCell.Offset(0, 4) = Me.txtMooringAnchoring.Value
            ActiveCell.Offset(0, 5) = Me.txtBulwarksRailling.Value
            ActiveCell.Offset(0, 6) = Me.txtSuperstrMCP.Value
            ActiveCell.Offset(0, 7) = Me.txtSuperstrOutf.Value
            ActiveCell.Offset(0, 8) = Me.txtFoundations.Value
            ActiveCell.Offset(0, 9) = Me.txtHMCP.Value
            ActiveCell.Offset(0, 10) = Me.txtHullOutf.Value
            ActiveCell.Offset(0, 11) = Me.txtWindowsPortholes.Value
            ActiveCell.Offset(0, 12) = Me.txtDoorsHatches.Value
            ActiveCell.Offset(0, 13) = Me.txtTT.Value
            ActiveCell.Offset(0, 14) = Me.txtWCS.Value
            ActiveCell.Offset(0, 15) = Me.txtLSA.Value
            ActiveCell.Offset(0, 16) = Me.txtFoldBalcAccSyst.Value
            ActiveCell.Offset(0, 17) = Me.txtDeckArrLayouts.Value
            ActiveCell.Offset(0, 18) = Me.txtNavLight.Value
            ActiveCell.Offset(0, 19) = Me.txtAntDomRadars.Value
            ActiveCell.Offset(0, 20) = Me.txtFEM.Value
            ActiveCell.Offset(0, 21) = Me.txtLocVibr.Value
        End With
'opslaan afdelingsoverzicht discipline CNS
ActiveWorkbook.Save
       
        
End Sub