Problems Copy table content and reset contentControls

[h0mebrewer]

Hello,

I'm glad that I found this discussion board and I hope that someone could help me.

I've some trouble to get my VBA Script working.
My document is used as a form to get some user input.
It has some tables, each of them has a button, which selects the content of the table, copy the content to the end of the table where the button was pressed.

The table contains contentcontrols, to get the user input.

I have two problems.
1. If I press my copy button, sometimes the table will be copied several times.
2. I would like to remove text, checkbox und date values form the fresh copy at the end of the table.
Here is the code of my Macro:

Sub copyTableStructure(tblNr As Long, startRow As Integer, endRow As Integer, endColumn As Integer, rowsToInsert As Integer, maxCopies As Integer)
    Dim dataRange As Range
    Dim lastRow As Range
    Dim newDataRange As Range
    Set oDoc = ActiveDocument
   
    If (oDoc.ProtectionType <> wdNoProtection) Then
        oDoc.Unprotect Password:="xxx"
    End If
   With ActiveDocument
   
    
        Set dataRange = .Range(Start:=.Tables(tblNr).Cell(startRow, 1).Range.Start, End:=.Tables(tblNr).Cell(endRow, endColumn).Range.End)
        dataRange.Select
        Selection.Copy
    End With
   
    If (Selection.Rows.Count <= (maxCopies * (endRow - startRow))) Then
        With ActiveDocument
            Tables(tblNr).Select
       
            Set lastRow = .Range(Start:=.Tables(tblNr).Cell(Selection.Rows.Count, 1).Range.Start, End:=.Tables(tblNr).Cell(Selection.Rows.Count, endColumn).Range.End)
            lastRow.Select
            Selection.InsertRowsBelow (rowsToInsert)
        End With
   
        With ActiveDocument
            Tables(tblNr).Select
            Set newDataRange = .Range(Start:=.Tables(tblNr).Cell(Selection.Rows.Count - rowsToInsert + 1, 1).Range.Start, End:=.Tables(tblNr).Cell(Selection.Rows.Count, endColumn).Range.End)
            newDataRange.Select
            Selection.Paste
             newDataRange.Select
            Dim oFF As FormField
            Dim contentCtrl As contentControl
       
            For Each contentCtrl In Selection.Range.contentControls
                If contentCtrl.Type = wdContentControlCheckBox Then
                    contentCtrl.Checked = False
                End If
                If contentCtrl.Type = wdContentControlText Then
                    contentCtrl.Range.Text = ""
                 
                End If
                Next contentCtrl
               
            
            For Each oFF In Selection.Range.FormFields
                oFF.Result = vbNullString
          
                If oFF.Type = wdFieldFormCheckBox Then
                    oFF.Result = vbFalse
                End If
               
                If oFF.Type = wdFieldFormTextInput Then
                    oFF.TextInput.Clear
                End If
                Next oFF
           
            Selection.Fields.Update
           
        End With
   
    Else
          Dim msg As String
          msg = "Not possible to add any other block"
          MsgBox (msg)
    End If
    If (oDoc.ProtectionType = wdNoProtection) Then
        oDoc.Protect Type:=wdAllowOnlyFormFields, NoReset:=True, Password:="xxx"
    End If
End Sub
 
Private Sub schoolBtn_Click()
    Call copyTableStructure(3, 2, 6, 2, 5, 99)
    NoAbschlussBtn.Value = False
End Sub
  
Private Sub WorkBtn_Click()
    Call copyTableStructure(5, 2, 8, 2, 7, 99)
    NoAbschlussBtn.Value = False
   
End Sub
 
Private Sub UniveristyBtn_Click()
    Call copyTableStructure(9, 2, 5, 2, 4, 99)
    PraktikaBtn.Value = False
  
End Sub

I hope that someone could help me.

Best regards

H0mebrewer