You are here:---Rispondi a: [RISOLTO] Split e copia dati da Celle Foglio1 a Celle Foglio2
Rispondi a: [RISOLTO] Split e copia dati da Celle Foglio1 a Celle Foglio22018-06-12T17:19:30+02:00

Home Forum Domande su Excel VBA e MACRO [RISOLTO] Split e copia dati da Celle Foglio1 a Celle Foglio2 Rispondi a: [RISOLTO] Split e copia dati da Celle Foglio1 a Celle Foglio2

sidsid
Moderatore
    Post totali: 718

    Questo il codice da abbinare al pulsante della form
    Per modificare i caratteri ammessi nella cella, devi agire sull’istruzione
    nCaratteri = 90

    Private Sub CommandButton1_Click()
    Dim nRiga As Long, j As Long, jj As Long
    Dim nCaratteri As Integer
    Dim sStringa As String, s1 As String, s2 As String
    Dim ws1 As Worksheet, ws2 As Worksheet
    Dim v As Variant
    
    Set ws1 = Sheets("Foglio1") 'nome foglio sorgente
    Set ws2 = Sheets("Foglio3") 'nome foglio bersaglio
    ws2.Range("A1:A8").ClearContents
    
    nCaratteri = 90
    
    nRiga = 1
    For j = 0 To Me.ListBox1.ListCount - 1
        sStringa = Me.ListBox1.List(j)
        If Me.ListBox1.Selected(j) Then
            If Len(sStringa) > nCaratteri Then
                v = Split(sStringa, " ")
                For jj = LBound(v) To UBound(v)
                    s1 = s1 & v(jj) & " "
                    s2 = s1 & v(jj + 1) & " "
                    If Not Len(s2) <= nCaratteri Then
                        ws2.Range("A" & nRiga).Value = Mid(s1, 1, Len(s1) - 1)
                        ws2.Range("A" & nRiga + 1).Value = Mid(sStringa, Len(s1) + 1, Len(sStringa))
                        Exit For
                    End If
                Next jj
            Else
                ws2.Range("A" & nRiga).Value = sStringa
            End If
        End If
        nRiga = nRiga + 3
        s1 = vbNullString
        s2 = vbNullString
    Next j
    Unload Me
    Set ws1 = Nothing
    Set ws2 = Nothing
    End Sub

    Utilizzando il sito, accetti l'utilizzo dei cookie da parte nostra. maggiori informazioni

    Questo sito utilizza i cookie per fornire la migliore esperienza di navigazione possibile. Continuando a utilizzare questo sito senza modificare le impostazioni dei cookie o cliccando su "Accetta" permetti il loro utilizzo.

    Chiudi