Condividi:        

Copia e incolla di più range in una volta sola

Vuoi potenziare i tuoi documenti Word? Non sai come si fa una macro in Excel? Devi creare una presentazione in PowerPoint?
Oppure sei passato a OpenOffice e non sei sicuro di come lavorare al meglio?

Moderatori: Anthony47, Flash30005

Copia e incolla di più range in una volta sola

Postdi wallace&gromit » 26/05/23 15:55

Ciao,
mi piacerebbe avere una macro che mi permetta di spostarmi una volta sola dai singoli file di origine alla banca dati.
Dovrebbe essere una macro molto flessibile, che di volta in volta chiede di selezionare i range.
Le mosse sono queste.
Apri un file origine, lanci la macro che ti chiede il primo range. Lo selezioni manualmente. OK
Quindi ti chiede i range successivi oppure se hai finito.

Se hai finito ti sposti in banca dati e la macro ti chiede dove vuoi inserire il primo range, selezioni la cella e dai l'OK, ti compila con tutti i dati del primo range.
Così via con tutti i range copiati in precedenza.

Finito questo la macro si può anche chiudere, vado sul prossimo file di origine e la rilancio.

È una cosa difficile? Penso che si debba lavorare con gli array, ma non sono ancora capace, nonostante gli anni di frequentazione del forum :oops:
Office2016 + 2019 su win11
Avatar utente
wallace&gromit
Utente Senior
 
Post: 2180
Iscritto il: 16/01/12 14:21

Sponsor
 

Re: Copia e incolla di più range in una volta sola

Postdi Anthony47 » 26/05/23 16:10

E' sufficiente copiare i Valori o bisogna copiare anche i Formati??
Ogni range copiato ha una sua specifica destinazione, o sono tipo affiancati o accodati?
Il file di origine e' gia' aperto o va aperto dalla macro?
Avatar utente
Anthony47
Moderatore
 
Post: 19465
Iscritto il: 21/03/06 16:03
Località: Ivrea

Re: Copia e incolla di più range in una volta sola

Postdi wallace&gromit » 26/05/23 16:26

Si copiano solo i valori.
Per il range di destinazione va selezionata una sola cella, poi si incolla da lì in giù (per semplicità per il momento ho singole colonne).
Ogni range copiato ha una cella di destinazione differente, perché le lunghezze dei range possono essere differenti, vanno accodati a valori precedenti di altri file.
I file sono già aperti, possono variare, quindi meglio che possa scegliere io.
Office2016 + 2019 su win11
Avatar utente
wallace&gromit
Utente Senior
 
Post: 2180
Iscritto il: 16/01/12 14:21

Re: Copia e incolla di più range in una volta sola

Postdi Anthony47 » 28/05/23 11:04

Pensavo sarebbe stato piu’ semplice ma non e’ stata così...
In particolare e’ stato non semplice immaginare come l’utente possa scegliere 5-10 intervalli e poi saperli riposizionere correttamente al momento del copia/incolla.

Quello che propongo e’ una soluzione che funziona in questo modo:
-in un prima fase l’utente identifica e salva la descrizione delle aree da migrare
-in una seconda fase all’utente vengono presentate in sequenza le aree salvate, e puo’ Incollarle nel file di destinazione previa scelta della posizione di salvataggio

Il tutto e’ dimostrato nel file scaricabile qui:
https://www.dropbox.com/s/g9yurh4ksh3lz ... .xlsm?dl=0

Piu’ in dettaglio:
A) Partendo da Foglio1, il pulsante avvia una form di guida, che imposta la fase di “Copia”
Immagine

B) Scegliere le aree da salvare:
1)Selezionare a mano il workbook e il foglio; selezionare l’intervallo da Copiare
2)Tornare sulla Form e premere il pulsante Salva. Il TextBox (TB) “B” indica nome file, nome foglio, intervallo selezionato
3)Premere Next: il tb A indicherà “2”, il tb B viene svuotato, per accogliere la nuova selezione
Ripetere le fasi 1-2-3 per tutte le aree da Copiare
Usando i “pulsanti” < e > del gruppo C ci si puo’ spostare tra le posizioni salvate. E’ possibile modificare una posizione riposizionandosi sul blocco da modificare, riselezionare una nuova area, premere Salva; un msgbox chiedera’ conferma della volontà di sostituire i dati coi nuovi.

C) Completato il salvataggio delle aree da copiare si preme il pulsante Vai a Incolla, che abilita il secondo blocco di pulsanti e imposta nei tb A e B i dati del primo blocco da Copiare /Incollare
1)Premere il pulsante Incolla: verrà chiesto di selezionare l’area dove incollare (che deve essere sul file che contiene le macro in esecuzione) e verrà eseguito il Copia /Incolla speciale – Valori.
Se si ripreme Incolla (senza prima fare Next) verrà chiesto se si vuole incollare nuovamente lo stesso blocco
2)Premere Next per avanzare al blocco successivo. Se si premesse Next senza aver Incollato il blocco un msgbox avverte e chiede se skippare o no. Premendo Next quando si e’ gia’ arrivati all’ultimo blocco un msgbox avvisa che e’ finita

D) Completato il Copia /Incolla si puo’ chiudere la form con la X oppure si puo’ cominciare una nuova fase di Copia, tornando alla fase B, tramite il pulsante Nuova Copia

Note:
-il file slave (quello da cui copiare) puo' essere gia' "aperto" all'avvio della form, ma puo' anche venire aperto con la form gia' visualizzata.
-teoricamente un ciclo potrebbe selezionare anche da piu' file "slave", ma mi sembra un buon modo per incasinarsi
-l'area di Incolla deve trovarsi sul file che contiene le macro in esecuzione


Cose che non mi piacciono ma che non sono riuscito ad aggirare:
-lo spostamento tra i file va fatto a mano; non sono infatti riuscito a muovermi tra i file in modo affidabile tramite vba (ad esempio per tornare sul foglio su cui selezionare le aree da copiare dopo aver salvato una selezione)
-la form e’ associata al file “master”, quindi non e’ visibile mentre si sceglie l’area da copiare; bisogna quindi dalla form andare manualmente al file slave (quello da cui copiare), fare la selezione, tornare al file master per il ciclo Salva /Next, tornare al file slave per rifare la seconda selezione; e così via avanti e indietro

Per cominciare puoi simulare qualcosa lavorando sul foglio Demo.
Per importare poi le macro nel tuo file “master”:
1) copiare il contenuto di Modulo1 in un nuovo Modulo del tuo vba
2) esportare la userform e importarla nel tuo file
-dal vba: selezionare la userform; Menu /File /Esporta file. Verrano creati un file .frm e uno .frx
-selezionare il progetto vba del tuo file; Menu /File /Importa file: seleziona il file frm precedentemente creato e importarlo

Prova e poi vedremo che farne...
Avatar utente
Anthony47
Moderatore
 
Post: 19465
Iscritto il: 21/03/06 16:03
Località: Ivrea

Re: Copia e incolla di più range in una volta sola

Postdi wallace&gromit » 28/05/23 16:33

È già molto bello!!!
Vediamo se c'è qualcosa da migliorare.
Prima di tutto però un problema che segnali non sussiste: se sullo schermo ho i due file in finestre affiancate posso tranquillamente selezionare mano a mano tutte le aree che mi interessano e copiarle, vedendo sempre la userform a fianco.

Quindi la fase di copia direi che è perfetta così. Piccolo appunto di macro però:
Ho dovuto scrivere: tMex(1) & Chr(10) & tMex(2) & Chr(10) & tMex(3) , perché con: Application.TextJoin(Chr(10), False, tMex) mi dava errore.

La fase di incolla era invece un po' troppo laboriosa.
Ho tolto la parte in cui si chiede ogni volta il range "rispo*, procedendo direttamente con incolla su active.cell.
Ci mette un attimo ad elaborare, ma poi lo fa senza problemi.

Ho tolto anche il limite che avevi imposto: che si può incollare solo nel file in cui si trova la macro, era importante?
A me farebbe comodo così, di modo che posso usare la procedura su qualsiasi file xlsx, magari mettendo tutta la macro sul personal.xlsb?
Sempre col sistema delle finestre affiancate faccio tutto senza dovere modificare la schermata.

Qui la macro modificata:
Codice: Seleziona tutto
Private Sub CBCopia_Click()
'Salva Selezione
Dim tMex(1 To 3) As String, mySplit
'
tMex(1) = ActiveWorkbook.Name
tMex(2) = ActiveSheet.Name
tMex(3) = Selection.Address(0, 0)
If Len(Me.TBSel.Text) < 3 Then
    Me.TBSel.Text = tMex(1) & Chr(10) & tMex(2) & Chr(10) & tMex(3) 'Application.TextJoin(Chr(10), False, tMex)
    MemoArr(CLng(Me.TBBlock.Text)) = tMex(1) & Chr(10) & tMex(2) & Chr(10) & tMex(3)  'Application.TextJoin(Chr(10), False, tMex)
Else
    rispo = MsgBox("Vuoi SOSTITUIRE i dati già salvati?", vbYesNo)
    If rispo = vbYes Then
        Me.TBSel.Text = ""
        Me.TBSel.BackColor = RGB(255, 200, 200)
        DoEvents
        Sleep 200
        Me.TBSel.BackColor = RGB(255, 255, 255)
        Me.TBSel.Text = Application.TextJoin(Chr(10), False, tMex)
        MemoArr(CLng(Me.TBBlock.Text)) = Application.TextJoin(Chr(10), False, tMex)
       
   
    Else
   
    End If

End If
If Len(Me.TBSel.Text) > 3 Then
    mySplit = Split(Me.TBSel.Text & " " & Chr(10), Chr(10), , vbTextCompare)
    On Error Resume Next
        Windows(mySplit(0)).Activate
        DoEvents
    On Error GoTo 0
End If
End Sub

Private Sub CBFase2_Click()
'Passa a Copia /Incolla

If Len(MemoArr(1)) < 3 Then
    MsgBox ("Non c'è niente di salvato da poter incollare"): Beep
    Exit Sub
End If
Me.Frame2.Enabled = True
Me.Frame1.BackColor = Me.BackColor
Me.Frame2.BackColor = RGB(230, 230, 200)
Me.Frame1.Enabled = False
Me.TBBlock.Value = 1
Me.TBSel.Value = MemoArr(1)
Me.TBSel.BackColor = RGB(255, 255, 255)
Me.Label3.Enabled = False
Me.Label4.Enabled = False

End Sub

Private Sub CBNext_Click()
'Next block
If CLng(Me.TBBlock.Text) = UBound(MemoArr) Then
    If Len(MemoArr(UBound(MemoArr))) > 0 Then
        Me.TBBlock.Value = CLng(Me.TBBlock.Text) + 1
        Me.TBSel.Text = ""
        ReDim Preserve MemoArr(1 To UBound(MemoArr) + 1)
    Else
        Me.TBSel.BackColor = RGB(255, 200, 200)
        DoEvents
        Sleep 100
        Me.TBSel.BackColor = RGB(255, 255, 255)
        Beep
    End If
Else
    'review +1
    Call Label4_Click
    Me.Label4.BackColor = RGB(255, 100, 100)
    DoEvents
    Sleep 200
    Me.Label4.BackColor = RGB(220, 220, 220)
End If
End Sub

Private Sub CBPaste_Click()
Dim sRng As Range, myDest As Range, mySplit
'
If Me.TBSel.BackColor <> RGB(255, 255, 255) Then
    rispo = MsgBox("Questo blocco sembra sia già stato copiato; copiare in una nuova posizione?", vbYesNo)
    If rispo <> vbYes Then Exit Sub
End If
If Len(Me.TBSel.Text) < 3 Then
    MsgBox ("Non c'è niente da salvare"): Beep
    Exit Sub
End If
'
'rispo = MsgBox("Selezionare destinazione per Blocco #_" & Me.TBBlock.Text & vbCrLf & "OK per eseguire, o ANNULLA", vbOKCancel)
'If rispo <> vbOK Then Exit Sub
On Error Resume Next
    '1 Set rispo = Application.InputBox("Selezionare destinazione per Blocco #_" & Me.TBBlock.Text & vbCrLf & "OK per eseguire, o ANNULLA", Type:=8)
    '1 Application.GoTo rispo
    '1 rispo.Cells(1, 1).Select
On Error GoTo 0
'1 If TypeName(rispo) <> "Range" Then Exit Sub

If Len(Me.TBSel.Text) > 3 Then
    mySplit = Split(Replace(Me.TBSel.Text, Chr(13), "", , , vbTextCompare) & " " & Chr(10), Chr(10), , vbTextCompare)
    On Error Resume Next
        Set sRng = Workbooks(mySplit(0)).Sheets(mySplit(1)).Range(mySplit(2))
        Set myDest = ActiveCell
    On Error Resume Next
   '2 If ActiveWorkbook.Name = ThisWorkbook.Name Then
        If sRng Is Nothing Then
            MsgBox ("Impossibile selezionae l'area da Copiare, processo abortito")
            Debug.Print "Err in CBPaste_Click", Replace(Replace(Me.TBSel.Text, Chr(10), " # ", , , vbTextCompare), Chr(13), "", , , vbTextCompare)
            Exit Sub
        End If
        If myDest Is Nothing Then
            MsgBox ("Scegliere una Destinazione valida e riprovare")
            Exit Sub
        End If
        'Controlli Ok, esegui copia:
        sRng.Copy
        myDest.PasteSpecial xlPasteValues
        Application.CutCopyMode = False
        Debug.Print "Copia eseguita:", "Block# " & Me.TBBlock.Text
        Debug.Print "  ", "From: " & Replace(Replace(Me.TBSel.Text, Chr(10), " # ", , , vbTextCompare), Chr(13), "", , , vbTextCompare), "To: " & myDest.Address(0, 0)
        Me.TBSel.BackColor = RGB(230, 255, 230)
   '2 Else
   '2     MsgBox ("La destinazione non e' su " & ThisWorkbook.Name & "; Copia /Incolla non eseguita")
   '2     Exit Sub
   '2 End If
   
Else

End If
End Sub





Private Sub CBPasteNext_Click()
'Avanza al Next Copia /Incolla
Dim I As Long

If CLng(Me.TBBlock.Value) = UBound(MemoArr) Then
    MsgBox ("Ultima Posizione già raggiunta; impossibile avanzare")
    Exit Sub
End If

If Me.TBSel.BackColor <> RGB(255, 255, 255) Then
    I = CLng(Me.TBBlock.Value) + 1
    Me.TBSel.Text = MemoArr(I)
    Me.TBBlock.Value = I
    Me.TBSel.BackColor = RGB(255, 255, 255)
   
Else
    rispo = MsgBox("Il blocco corrente sembra che non sia ancora salvato: vuoi skipparlo e andare avanti?", vbYesNo)
    If rispo = vbYes Then
        Me.TBSel.BackColor = RGB(200, 200, 200)
        Call CBPasteNext_Click
    End If

End If

End Sub

Private Sub CBReCopy_Click()
'Passa a una nuova Copia
'
If Replace(Me.TBSel, Chr(13), "", , , vbTextCompare) = MemoArr(UBound(MemoArr)) And _
  Me.TBSel.BackColor <> RGB(255, 255, 255) Then
    ReDim MemoArr(1 To 1)
    Me.Frame1.Enabled = True
    Me.Frame2.BackColor = Me.BackColor
    Me.Frame1.BackColor = RGB(230, 230, 200)
    Me.Frame2.Enabled = False
    Me.TBBlock.Value = 1
    Me.TBSel.Value = MemoArr(1)
    Me.TBSel.BackColor = RGB(255, 255, 255)
    Me.Label3.Enabled = True
    Me.Label4.Enabled = True
Else
    rispo = MsgBox("Le Copie salvate non sono state tutte salvate, vuoi veramente passare a una nuova fase di Copia?", vbYesNo)
    If rispo = vbYes Then
        Me.TBSel = MemoArr(UBound(MemoArr))
        Me.TBSel.BackColor = RGB(255, 230, 255)
        Call CBReCopy_Click
    Else
   
    End If
End If
End Sub

Private Sub Label3_Click()
'Review -1
If CLng(Me.TBBlock.Text) > 1 Then
    Me.TBBlock.Text = CLng(Me.TBBlock.Text) - 1
    Me.TBSel.Text = MemoArr(CLng(Me.TBBlock.Text))
    Call FlashControl("TBBlock")
Else
    Beep
End If
End Sub

Private Sub Label4_Click()
'Review +1
If CLng(Me.TBBlock.Text) < UBound(MemoArr) Then
    Me.TBBlock.Value = CLng(Me.TBBlock.Text) + 1
    Me.TBSel.Text = MemoArr(CLng(Me.TBBlock.Text))
    Call FlashControl("TBBlock")
Else
    Beep
End If

End Sub


Private Sub UserForm_Activate()
ReDim StoreArr(1 To 1)
ReDim MemoArr(1 To 1)
'
Me.TBBlock.Text = 1
Me.Label3.BackColor = RGB(220, 220, 220)
Me.Label4.BackColor = RGB(220, 220, 220)
Me.CBCopia.BackColor = RGB(230, 220, 220)
Me.CBFase2.BackColor = RGB(220, 220, 230)
Me.CBNext.BackColor = RGB(220, 230, 220)
Me.TBBlock.Enabled = False
Me.TBSel.Enabled = False
Me.Frame1.BackColor = RGB(230, 230, 200)
Me.TBSel.BackColor = RGB(255, 255, 255)
Me.Frame2.Enabled = False

End Sub

Private Sub UserForm_Click()
'Debug.Print Me.TBSel.BackColor
End Sub


Sub FlashControl(ContrlN As String)
Dim ccCol As Long
'
With Me.Controls(ContrlN)
    ccCol = .BackColor
    .BackColor = RGB(255, 200, 200)
    DoEvents
    Sleep 200
    .BackColor = ccCol
End With

End Sub
Office2016 + 2019 su win11
Avatar utente
wallace&gromit
Utente Senior
 
Post: 2180
Iscritto il: 16/01/12 14:21

Re: Copia e incolla di più range in una volta sola

Postdi wallace&gromit » 28/05/23 16:57

SI PUÒ FAREEE!
L'ho messo sul personal.xlsb ed è geniale, mi apre solo la userform e io posso copiare e incollare a volontà.
Secondo me questo programmino dovrebbe avere un posto d'onore tra "i vostri lavori", oppure un nuovo settore "le perle di Anthony".
Office2016 + 2019 su win11
Avatar utente
wallace&gromit
Utente Senior
 
Post: 2180
Iscritto il: 16/01/12 14:21

Re: Copia e incolla di più range in una volta sola

Postdi Anthony47 » 28/05/23 20:54

Secondo me questo programmino dovrebbe avere un posto d'onore tra "i vostri lavori", oppure un nuovo settore "le perle di Anthony"

Non condivido tutto questo entusiasmo; anche perche’ mi pare che nella tua attuale configurazione abbiamo sostituito Contr-c e Contr-Alt-v con una userform (e la mia configurazione fa poco di piu’): Gromit se la sta ridendo di brutto
Avatar utente
Anthony47
Moderatore
 
Post: 19465
Iscritto il: 21/03/06 16:03
Località: Ivrea

Re: Copia e incolla di più range in una volta sola

Postdi papiriof » 30/05/23 17:14

Sto pensando a come utilizzarlo, è molto bello :idea: :idea:
Win 7+Office 2010
papiriof
Utente Senior
 
Post: 408
Iscritto il: 16/02/10 13:23


Torna a Applicazioni Office Windows


Topic correlati a "Copia e incolla di più range in una volta sola":


Chi c’è in linea

Visitano il forum: Nessuno e 9 ospiti