Ciao, eccolo

grazie

Private Sub caricacomboRicerca()
    Dim ur As Long, i As Long
    
    ur = Cells(Rows.Count, "A").End(xlUp).Row
    
    If ur < 2 Then Exit Sub '<--se non sono presenti nominativi allora non caricare nulla
    
    With cboRicerca
        .Clear
        .ColumnCount = 2 '<--imposto la ComboBox a 2 colonne
        .ColumnWidths = "0 pt" '<--la prima colonna non la mostro
             
        
         For i = 2 To ur
         If i Mod 2 = 0 Then
         .AddItem i '<--carico in colonna 1 della ComboBox il numero di riga in modo da poterlo sfruttare al momento di eventuali modifiche/eliminazioni/caricamenti
         .List(.ListCount - 1, 1) = Cells(i, "A").Value & " " & Cells(i, "B").Value '<--carico in colonna 2 il contatore ed il nominativo
         End If
        Next i

        
    End With
End Sub
Private Sub CmdCalcolatrice_Click()
UserForm2.Show
End Sub

Private Sub cmdInvia_Click()
    Dim contatore As Long
    Dim rigaDebitore As Variant
    Dim ctl As Control
    Dim arr() As Variant
    Dim r As Long, c As Long, nRows As Long, nCols As Long, k As Long
    Dim temp1 As Variant, regolarita As Variant
    Dim aziendaCedente As String
    Dim f As Range
    Dim wsFee As Worksheet
    
      If Trim(TxtContatore.Value) = "" Then Exit Sub
    
 
    
      
    'per ogni controllo nella UserForm
    For Each ctl In Me.Controls
        'se il controllo è una TextBox o ComboBox allora...
        If TypeName(ctl) = "TextBox" Or TypeName(ctl) = "ComboBox" Then
            'ad esclusione della ComboBox cboRicerca...
            If ctl.Name <> "cboRicerca" Then
                If Trim(ctl.Value) = "" Then
                    MsgBox "Inserire " & ctl.Tag, vbExclamation, "Alert"
                    ctl.SetFocus
                    Exit Sub
                End If
            End If
        End If
    Next ctl

    contatore = TxtContatore.Value

    
    Set wsFee = ThisWorkbook.Worksheets("FEE")
    Set f = wsFee.Columns("A").Find(What:=TxtMandato.Value, LookIn:=xlValues, LookAt:=xlWhole)
    If Not f Is Nothing Then aziendaCedente = f.Offset(, 1).Value
    
    nRows = Cells(Rows.Count, "F").End(xlUp).Row
    nCols = 19
    ReDim arr(1 To (nRows + 1), 1 To nCols) As Variant
    
    For r = LBound(arr, 1) To nRows - 1
        For c = LBound(arr, 2) To nCols
            arr(r, c) = Cells(r + 1, c).Value
        Next c
    Next r
    arr(nRows, 1) = contatore 'A
    arr(nRows, 2) = TxtCliente 'B
    arr(nRows, 3) = CDate(Format(TxtDataOper, "dd/mm/yy")) 'C
    arr(nRows, 4) = aziendaCedente
    arr(nRows, 5) = TxtMandato.Value 'E
    arr(nRows, 6) = CDate(Format(TxtScadPag, "dd/mm/yy")) 'F '<-- da replicare
    'arr(nRows, 7) = CLng(arr(nRows, 6)) - CLng(Date) 'G
    arr(nRows, 8) = TxtDebOrigin.Value
    arr(nRows, 9) = TxtAccord.Value 'I
    arr(nRows, 10) = TxtNumRate.Value 'J
    arr(nRows, 11) = TxtNumRate.Value 'K
    arr(nRows, 12) = TxtDaPag.Value 'L
    arr(nRows, 13) = "No"
    
 
    
    arr(nRows, 15) = "No"
 
    If TxtNumRate > 1 Then
        arr(nRows, 14) = "PLURI" 'N
    Else
        arr(nRows, 14) = "UNI" 'N
    End If
            
    If TxtDirLiber = "S" Then
        arr(nRows, 16) = "Si" 'P
    Else
        arr(nRows, 16) = "No"
    End If
    
    arr(nRows, 17) = "No" 'Q
    
    If TxtCorrelate = "S" Then
        arr(nRows, 18) = "Si" 'R
    Else
        arr(nRows, 18) = "No"
    End If
        
    Select Case TxtModalPag 'S
        Case 1
            arr(nRows, 19) = "Bonif"
        Case 2
            arr(nRows, 19) = "B_post"
        Case 3
            arr(nRows, 19) = "QrCode"
        Case Else
            arr(nRows, 19) = "null"
    End Select
    arr(nRows + 1, 2) = TxtCodfisc.Value 'B - C.F. in seconda riga
    arr(nRows + 1, 3) = TxtTelefono.Text 'C - Nr. di telefono in seconda riga
    arr(nRows + 1, 6) = CDate(Format(TxtScadPag, "dd/mm/yy")) 'F '<--replicato
    arr(nRows + 1, 18) = CDate(Format(Txt_Data_ultima_rich_correlate, "dd/mm/yy")) 'R <-- replicato
    
    'Bubble Sort
    For r = 1 To UBound(arr, 1) - 2 Step 2
        For c = r + 2 To UBound(arr, 1) Step 2
            If UCase(arr(c, 2)) < UCase(arr(r, 2)) Then
                ReDim temp1(1 To 2, 1 To UBound(arr, 2))
                
                For k = 1 To UBound(arr, 2)
                    temp1(1, k) = arr(r, k)
                Next k
                temp1(2, 2) = arr(r + 1, 2)
                temp1(2, 3) = arr(r + 1, 3)
                temp1(2, 6) = arr(r + 1, 6)
                
                For k = 1 To UBound(arr, 2)
                    arr(r, k) = arr(c, k)
                Next k
                arr(r + 1, 2) = arr(c + 1, 2)
                arr(r + 1, 3) = arr(c + 1, 3)
                arr(r + 1, 6) = arr(c + 1, 6)
                
                For k = 1 To UBound(arr, 2)
                    arr(c, k) = temp1(1, k)
                Next k
                arr(c + 1, 2) = temp1(2, 2)
                arr(c + 1, 3) = temp1(2, 3)
                arr(c + 1, 6) = temp1(2, 6)
            End If
        Next c
    Next r
    
    Application.EnableEvents = False
    Application.ScreenUpdating = False
    If nRows > 1 Then
        On Error Resume Next
        Range("A2:S" & nRows).ClearContents
        On Error GoTo 0
    End If
    
    For r = LBound(arr, 1) To UBound(arr, 1)
        Cells(r + 1, "A").Value = arr(r, 1)
        Cells(r + 1, "B").Value = arr(r, 2)
        If IsDate(arr(r, 3)) And InStr(arr(r, 3), "/") > 0 Then
            Cells(r + 1, "C").NumberFormat = "dd/mm/yy"
        Else
            Cells(r + 1, "C").NumberFormat = "General"
        End If
        Cells(r + 1, "C").Value = arr(r, 3)
        Cells(r + 1, "D").Value = arr(r, 4)
        Cells(r + 1, "E").Value = arr(r, 5)
        Cells(r + 1, "F").Value = arr(r, 6)
        If (r + 1) Mod 2 = 0 Then
            Cells(r + 1, "G").FormulaLocal = "=SE(M" & (r + 1) & "=""Si"";""PAGATO"";F" & (r + 2) & "-OGGI())"
        End If
        
        If Not IsEmpty(arr(r, 8)) And IsNumeric(arr(r, 8)) Then
            Cells(r + 1, "H").NumberFormat = "#,##0.00"
            Cells(r + 1, "H").Value = CDbl(arr(r, 8))
        Else
            Cells(r + 1, "H").NumberFormat = "#,##0.00"
        End If
        
        If Not IsEmpty(arr(r, 9)) And IsNumeric(arr(r, 9)) Then
            Cells(r + 1, "I").NumberFormat = "#,##0.00"
            Cells(r + 1, "I").Value = CDbl(arr(r, 9))
        Else
            Cells(r + 1, "I").NumberFormat = "#,##0.00"
        End If
        
        Cells(r + 1, "J").Value = arr(r, 10)
        Cells(r + 1, "K").Value = arr(r, 11)
        
        If Not IsEmpty(arr(r, 12)) And IsNumeric(arr(r, 12)) Then
            Cells(r + 1, "L").NumberFormat = "#,##0.00"
            Cells(r + 1, "L").Value = CDbl(arr(r, 12))
        Else
            Cells(r + 1, "L").NumberFormat = "#,##0.00"
        End If
        
        Cells(r + 1, "M").Value = arr(r, 13)
        Cells(r + 1, "N").Value = arr(r, 14)
        Cells(r + 1, "O").Value = arr(r, 15)
        Cells(r + 1, "P").Value = arr(r, 16)
        Cells(r + 1, "Q").Value = arr(r, 17)
        Cells(r + 1, "R").Value = arr(r, 18)
        Cells(r + 1, "S").Value = arr(r, 19)
    Next r
    Application.EnableEvents = True
    Application.ScreenUpdating = True
    
    Call cmdReset_Click
    
                caricacomboRicerca
                
    On Error Resume Next
    rigaDebitore = Application.Match(contatore, ActiveSheet.Range("A:A"), 0)
    On Error GoTo 0
    
    If Not IsError(rigaDebitore) Then
        Range("B" & rigaDebitore).Select
    End If

    MsgBox "Inserimento effettuato con successo", vbInformation, "Avviso"
    
    TxtContatore.SetFocus


End Sub

Ciao, solo qualche piccolo pezzettino 

ho creato una seconda userform che mi gestisce dei dati specifici tra cui l'inserimento di questa data.

Questo il codice assegnato al CommandButton

Private Sub CmdConfermaCorrelate_Click()

        
     Dim rigaContatore As Long

    ' Verifica se è stato selezionato un elemento
    If CboCercaNom.ListIndex = -1 Then Exit Sub
    
    ' Chiede conferma all'utente
    If MsgBox("Sei sicuro di voler confermare le nuove scelte?", vbQuestion + vbYesNo, "Conferma scelte") = vbNo Then Exit Sub

    ' Prelevo il numero di riga (Assicurati che CboCercaNom.Value sia un numero valido)
    rigaContatore = CLng(CboCercaNom.Value)


  ' Colonna R: Correlate e Data
    Cells(rigaContatore, "R").Value = IIf(ChkCorrelate.Value, "Si", "")
    
    If Txt_Data_ultima_rich_correlate.Value <> "" Then
        Cells(rigaContatore + 1, "R").Value = DateValue(Txt_Data_ultima_rich_correlate.Value)
    End If

    ' Chiusura Userform
    Unload Me
    
     
End Sub

e questo alla Textbox specifica

Private Sub Txt_Data_ultima_rich_correlate_Change()

    Dim s As String

    s = Replace(Txt_Data_ultima_rich_correlate.Text, "/", "")
    If Not IsNumeric(s) Then Exit Sub

    If Len(s) > 8 Then s = Left(s, 8)

    Select Case Len(s)
        Case Is <= 2
            Txt_Data_ultima_rich_correlate.Text = s
        Case Is <= 4
            Txt_Data_ultima_rich_correlate.Text = Left(s, 2) & "/" & Mid(s, 3)
        Case Else
            Txt_Data_ultima_rich_correlate.Text = Left(s, 2) & "/" & Mid(s, 3, 2) & "/" & Mid(s, 5)
    End Select

    Txt_Data_ultima_rich_correlate.SelStart = Len(Txt_Data_ultima_rich_correlate.Text)
End Sub