Copia/Incolla dati in celle NON contigue con destinazione in

[VisitorsVBA]

Salve,
ho un piccolo problema che non riesco a risolvere.
Da codice vba devo fare un copia incolla dati in celle NON contigue con destinazione in celle contigue.
Mi spiego meglio con questo esempio.

Sub copiaincolla()
Dim c1, c2, c3, Intervallo As Range

With Foglio2.Range("A2") ' dalla cella A2 fino all'ultima cella piena
Set c1 = Range(.Cells(1), .End(xlDown))
End With
With Foglio2.Range("H2") ' dalla cella H2 fino all'ultima cella piena
Set c2 = Range(.Cells(1), .End(xlDown))
End With
With Foglio1.Range("O2") ' dalla cella O2 fino all'ultima cella piena
Set c3 = Range(.Cells(1), .End(xlDown))
End With

Set Intervallo = Union(c1, c2, c3)

Intervallo.Copy Destination:=Worksheets("Foglio1").Range("A2")

End Sub

Cosi facendo, però, mi appare l'errore nella riga:
Set Intervallo = Union(c1, c2, c3)
con l'errore:
Metodo 'Union' dell'oggetto '_Global' non riuscito

Dove sbaglio?

Grazie

[Anthony47]

Ciao Visitors
E’ sempre difficile debuggare il codice di qualcun altro...
Secondo me ci sono 2 errori nella macro:
Intanto, non puoi unire range su fogli diversi; quindi potrai fare UNION (c1, c2) perche’ sullo stesso foglio ma non UNION(c1, c2, c3).
Poi, credo che la copy su una UNION i cui range hanno una lunghezza diversa tra di loro non funzioni.

Questo e’ quello che ricordo o credo di ricordare.

Quindi ti propongo di aggirare i vari ostacoli con la seguente macro, che e’ la tua nella prima parte e poi un finale per copiare/icollare in Foglio1 i range creati:

Codice: Seleziona tutto

Sub copiaincolla()
Dim c1, c2, c3, Intervallo As Range

With Foglio2.Range("A2") ' dalla cella A2 fino all'ultima cella piena
Set c1 = Range(.Cells(1), .End(xlDown))
End With
With Foglio2.Range("H2") ' dalla cella H2 fino all'ultima cella piena
Set c2 = Range(.Cells(1), .End(xlDown))
End With
With Foglio1.Range("O2") ' dalla cella O2 fino all'ultima cella piena
Set c3 = Range(.Cells(1), .End(xlDown))
End With
'
' Copia/Incolla su destinazione
Worksheets("Foglio1").Select
Range("A2").Select
c1.Copy
ActiveSheet.Paste
Range("B2").Select
c2.Copy
ActiveSheet.Paste
Range("C2").Select
c3.Copy
ActiveSheet.Paste
Application.CutCopyMode = False
End Sub

Finale poco sosisticato, ma funziona.

Ciao,

[Alexsandra]

Prova così

Codice: Seleziona tutto

Sub copiaincolla()
Dim c1, c2, c3, Intervallo As Range
 Set c1 = Range([A2], [A2].End(xlDown))
 Set c2 = Range([H2], [H2].End(xlDown))
 Set c3 = Range([O2], [O2].End(xlDown))

Set Intervallo = Union(c1, c2, c3)

Intervallo.Copy Worksheets("Foglio1").[A2]
End Sub

[Anthony47]

Ciao Alexsandra, lieto di ritrovarti.
Pero' secondo me la copy (in Intervallo.Copy) funziona solo se tutti i range sono di pari lunghezza.
E poi c3 dovrebbe essere relativa a Foglio1, mentre c1 e c2 a Foglio2. Si puo' fare Union tra range in fogli diversi?

Ciao,

[Anthony47]

Ciao a tutti,
anche a riguardare la situazione a mente fresca, io riconfermerei che non si possono fare UNION tridimensionali (range su fogli diversi) e che la copy e' impossibile se le lunghezze (N° di righe) sono diverse.

Sfrutterei l' eleganza de codice di Alexsandra con questa macro:

Codice: Seleziona tutto

Sub copiaincollaf()
Dim c1, c2, c3, Intervallo As Range

Sheets("Foglio2").Select
 Set c1 = Range([A2], [A2].End(xlDown))
 Set c2 = Range([H2], [H2].End(xlDown))
Sheets("Foglio1").Select
 Set c3 = Range([O2], [O2].End(xlDown))

c1.Copy Worksheets("Foglio3").Range("A2")
c2.Copy Worksheets("Foglio3").Range("B2")
c3.Copy Worksheets("Foglio3").Range("C2")

End Sub

Un ulteriore suggerimento: invece del metodo End(xlDown) io uso End(xlUp), in modo da evitare di interrompere la selezione alla prima cella vuota, inserendo cosi' anche eventuali celle successive; l' istruzione puo' essere del tipo

Codice: Seleziona tutto

 Set c1 = Range([A2], [A65536].End(xlUp))

Ciao,

[Anthony47]

Forse la mente non e' ancora (o non e' piu'??) fresca...
Ve ne siete accorti che ho erroneamente scritto Foglio3 nelle formule del destination, foglio che io ho usato nel collaudo della formula.

Visitor correggera' in Foglio1, come da sua esigenza.

Mi faccio un caffe' forte, ciao.

[VisitorsVBA]

Ciao ragazzi/e,
volevo ringranziarvi per i vostri suggerimenti.
Volevo, però, sottolineare che c1, c2, c3, Intervallo fanno parte dello stesso foglio (nel mio caso Foglio2), cioè c1 è un'intervallo, c2 un'altro e c3 un'altro ancora, Intervallo è l'unione dei 3 precedenti.
Quindi nel foglio1 c'è la macro "preleva dati" (dal Foglio2) e li copia sul Foglio1.
Io ho pensato di fare in questo modo e funziona, che ne pensate?

Sub copia()
Application.ScreenUpdating = False
Dim c1 As Range
Foglio2.Activate
Range("a2").Select
'SCENDI FINO A TROVARE LA PRIMA RIGA VUOTA
a = ActiveCell.Address
Selection.End(xlDown).Select
b = ActiveCell.Address
Set c1 = Range(a & ":" & b)

Dim c2 As Range
Foglio2.Activate
Range("h2").Select
'SCENDI FINO A TROVARE LA PRIMA RIGA VUOTA
a = ActiveCell.Address
Selection.End(xlDown).Select
b = ActiveCell.Address
Set c2 = Range(a & ":" & b)

Dim c3 As Range
Foglio2.Activate
Range("o2").Select
'SCENDI FINO A TROVARE LA PRIMA RIGA VUOTA
a = ActiveCell.Address
Selection.End(xlDown).Select
b = ActiveCell.Address
Set c3 = Range(a & ":" & b)

Dim Intervallo As Range
Set Intervallo = Union(c1, c2, c3)

Intervallo .Copy Destination:=Worksheets("Foglio1").Range("A2")
Foglio1.Activate
Range("A2").Activate
Application.ScreenUpdating = True
End Sub

[Alexsandra]

degli intervalli lo avevo capito, è giusta l'osservazione di antony che funziona solo con range di pari righe, non so come siano i tuoi range, ma comunque è una limitazione che ha la procedura

Se alla fine del range non hai altri dati, potresti usare il metodo union in altra maniera, cioè copiando tutta la colonna e anche se hai range con righe diverse non ti rimanda errore, praticamente dal codice che ti ho postato dovresti solo modificare 3 righe.

[VisitorsVBA]

Forse la mente non e' ancora (o non e' piu'??) fresca...
Ve ne siete accorti che ho erroneamente scritto Foglio3 nelle formule del destination, foglio che io ho usato nel collaudo della formula.

Visitor correggera' in Foglio1, come da sua esigenza.

Mi faccio un caffe' forte, ciao.

Effettivamente il mio codice funziona solo se il n° di righe sono uguali per tutte le 3 colonne. La mia mi sembra un pò lunga come procedura. Molto più elengante le vostre.

[VisitorsVBA]

degli intervalli lo avevo capito, è giusta l'osservazione di antony che funziona solo con range di pari righe, non so come siano i tuoi range, ma comunque è una limitazione che ha la procedura

Se alla fine del range non hai altri dati, potresti usare il metodo union in altra maniera, cioè copiando tutta la colonna e anche se hai range con righe diverse non ti rimanda errore, praticamente dal codice che ti ho postato dovresti solo modificare 3 righe.

Non capisco come usare union come dici tu.

[VisitorsVBA]

Ciao a tutti,
anche a riguardare la situazione a mente fresca, io riconfermerei che non si possono fare UNION tridimensionali (range su fogli diversi) e che la copy e' impossibile se le lunghezze (N° di righe) sono diverse.

Sfrutterei l' eleganza de codice di Alexsandra con questa macro:

Codice: Seleziona tutto

Sub copiaincollaf()
Dim c1, c2, c3, Intervallo As Range

Sheets("Foglio2").Select
 Set c1 = Range([A2], [A2].End(xlDown))
 Set c2 = Range([H2], [H2].End(xlDown))
Sheets("Foglio1").Select
 Set c3 = Range([O2], [O2].End(xlDown))

c1.Copy Worksheets("Foglio3").Range("A2")
c2.Copy Worksheets("Foglio3").Range("B2")
c3.Copy Worksheets("Foglio3").Range("C2")

End Sub

Un ulteriore suggerimento: invece del metodo End(xlDown) io uso End(xlUp), in modo da evitare di interrompere la selezione alla prima cella vuota, inserendo cosi' anche eventuali celle successive; l' istruzione puo' essere del tipo

Codice: Seleziona tutto

 Set c1 = Range([A2], [A65536].End(xlUp))

Ciao,

Utilizzando il suggerimento di Anthony47 in questo modo:
Sub copiaincollaOK()
Dim c1, c2, c3, Intervallo As Range
Sheets("Foglio2").Select
Set c1 = Range([A2], [A65536].End(xlUp))
Set c2 = Range([H2], [H65536].End(xlUp))
Set c3 = Range([O2], [O65536].End(xlUp))
c1.Copy Worksheets("Foglio1").Range("A2")
c2.Copy Worksheets("Foglio1").Range("B2")
c3.Copy Worksheets("Foglio1").Range("C2")
End Sub

Risolve due problemi:
1) il n° di righe uguali per tutte le colonne
2) pur essendoci celle vuote negli intervalli ti copia tutto l'intervallo

Grazie 1000


Adesso, vorrei continuare il codice copiando altri intervalli dal Foglio3 e aggiungendoli sotto quelli già copiati nel Foglio1.

Che ne pensate?

[VisitorsVBA]

Devo svegliarmi, ancora....
Volevo aggiungere il codice:

Application.ScreenUpdating = False

Dim c1, c2, c3, Intervallo As Range
Sheets("Foglio2").Select
Set c1 = Range([A2], [A65536].End(xlUp))
Set c2 = Range([H2], [H65536].End(xlUp))
Set c3 = Range([O2], [O65536].End(xlUp))
c1.Copy Worksheets("Foglio1").Range("A2")
c2.Copy Worksheets("Foglio1").Range("B2")
c3.Copy Worksheets("Foglio1").Range("C2")

Dim c11, c22, c33, Intervallo3 As Range
Sheets("Foglio3").Select
Set c11 = Range([A4], [A65536].End(xlUp))
Set c22 = Range([H4], [H65536].End(xlUp))
Set c33 = Range([O4], [O65536].End(xlUp))

' trova le celle vuote e copia

Foglio1.Activate
Range("a2").Activate
Application.ScreenUpdating = True

Una domanda che vi pongo dopo la suddetta soluzione è questa:

La stessa cosa si può fare utilizzando le matrici?

[VisitorsVBA]

Devo svegliarmi, ancora....
Volevo aggiungere il codice:

Application.ScreenUpdating = False

Dim c1, c2, c3, Intervallo As Range
Sheets("Foglio2").Select
Set c1 = Range([A2], [A65536].End(xlUp))
Set c2 = Range([H2], [H65536].End(xlUp))
Set c3 = Range([O2], [O65536].End(xlUp))
c1.Copy Worksheets("Foglio1").Range("A2")
c2.Copy Worksheets("Foglio1").Range("B2")
c3.Copy Worksheets("Foglio1").Range("C2")

Dim c11, c22, c33, Intervallo3 As Range
Sheets("Foglio3").Select
Set c11 = Range([A4], [A65536].End(xlUp))
Set c22 = Range([H4], [H65536].End(xlUp))
Set c33 = Range([O4], [O65536].End(xlUp))

' trova le celle vuote e copia

Foglio1.Activate
Range("a2").Activate
Application.ScreenUpdating = True

Una domanda che vi pongo dopo la suddetta soluzione è questa:

La stessa cosa si può fare utilizzando le matrici?

Ho fatto in questo modo ma non mi piace. Voi cosa dite?

Sub copiaincollaOK()
Application.ScreenUpdating = False

Dim c1, c2, c3, Intervallo As Range
Sheets("Foglio2").Select
Set c1 = Range([A2], [A65536].End(xlUp))
Set c2 = Range([H2], [H65536].End(xlUp))
Set c3 = Range([O2], [O65536].End(xlUp))
c1.Copy Worksheets("Foglio1").Range("A2")
c2.Copy Worksheets("Foglio1").Range("B2")
c3.Copy Worksheets("Foglio1").Range("C2")

Dim c11, c22, c33, Intervallo3 As Range
Sheets("Foglio3").Select
Set c11 = Range([A4], [A65536].End(xlUp))
Set c22 = Range([H4], [H65536].End(xlUp))
Set c33 = Range([O4], [O65536].End(xlUp))
Sheets("Foglio1").Activate

Range("A20").Select
Do
ActiveCell.End(xlUp).Select
Loop Until ActiveCell.Value <> ""
ActiveCell.Offset(1).Select
c11.Copy ActiveCell

Range("B20").Select
Do
ActiveCell.End(xlUp).Select
Loop Until ActiveCell.Value <> ""
ActiveCell.Offset(1).Select
c22.Copy ActiveCell

Range("C20").Select
Do
ActiveCell.End(xlUp).Select
Loop Until ActiveCell.Value <> ""
ActiveCell.Offset(1).Select
c33.Copy ActiveCell

Range("a2").Activate
Application.ScreenUpdating = True
End Sub

[Anthony47]

Ciao Visitor,
Allora la prima parte e’ ok; la seconda la sviluppi come la prima e usando quello che hai imparato fin qui.

Intanto, non c’ e’ bisogno di definire nuove variabili (c11, c22, c33) potendo riusare quelle che hai gia’ (c1, c2, c3); suggerimento nel suggerimento: in futuro evita di usare variabili con nome confondibile con un indirizzo di cella, soprattutto se prendi l’ abitudine di utilizzare l’ indirizzamento immediato (quello tra parentesi quadre, es Range[A2]).

Codice: Seleziona tutto

Sub copiaincollaOK()
'Application.ScreenUpdating = False     '<<<< SCOMMENTARE a fine debug

Dim c1, c2, c3, Intervallo As Range
Sheets("Foglio2").Select
Set c1 = Range([A2], [A65536].End(xlUp))
Set c2 = Range([H2], [H65536].End(xlUp))
Set c3 = Range([O2], [O65536].End(xlUp))
c1.Copy Worksheets("Foglio1").Range("A2")
c2.Copy Worksheets("Foglio1").Range("B2")
c3.Copy Worksheets("Foglio1").Range("C2")

'REPLAY PER FOGLIO3
Sheets("Foglio3").Select
Set c1 = Range([A4], [A65536].End(xlUp))
Set c2 = Range([H4], [H65536].End(xlUp))
Set c3 = Range([O4], [O65536].End(xlUp))

c1.Copy Worksheets("Foglio1").Range("A65536").End(xlUp).Offset(1, 0)
c2.Copy Worksheets("Foglio1").Range("B65536").End(xlUp).Offset(1, 0)
c3.Copy Worksheets("Foglio1").Range("C65536").End(xlUp).Offset(1, 0)

Application.ScreenUpdating = True

End Sub

Ti ho commentato (con l’ “apostrofo”) Application.ScreenUpdating = False, che scommenterai quando avrai finito il debug del tuo codice.
Nella seconda parte ho usato il metodo End(xlUp) per trovare l’ ultima cella occupata e Offset(1,0) per spostarmi 1 riga sotto (cioe’ sulla prima cella libera).

Voila.

Fatti sentire, ciao.

[Alexsandra]

Non capisco come usare union come dici tu.

Se cerchi in un intervallo di una colonna fino alla prima riga vuota ho pensato che alla fine del tuo range sulla colonna non ci sia più niente fino per tutte le righe a seguire.
Se questo è vero, allora semplifica il codice e prendi tutta la colonna, così puoi copiarti tutti i dati al di là che le righe siano uguali o no nel range.

Codice: Seleziona tutto

Sub copiaincolla()
 Set Intervallo = Union(Columns(1), Columns(8), Columns(15))
 Intervallo.Copy Worksheets("Foglio1").[A1]
End Sub

[VisitorsVBA]

Ciao Visitor,
Allora la prima parte e’ ok; la seconda la sviluppi come la prima e usando quello che hai imparato fin qui.

Intanto, non c’ e’ bisogno di definire nuove variabili (c11, c22, c33) potendo riusare quelle che hai gia’ (c1, c2, c3); suggerimento nel suggerimento: in futuro evita di usare variabili con nome confondibile con un indirizzo di cella, soprattutto se prendi l’ abitudine di utilizzare l’ indirizzamento immediato (quello tra parentesi quadre, es Range[A2]).

Codice: Seleziona tutto

Sub copiaincollaOK()
'Application.ScreenUpdating = False     '<<<< SCOMMENTARE a fine debug

Dim c1, c2, c3, Intervallo As Range
Sheets("Foglio2").Select
Set c1 = Range([A2], [A65536].End(xlUp))
Set c2 = Range([H2], [H65536].End(xlUp))
Set c3 = Range([O2], [O65536].End(xlUp))
c1.Copy Worksheets("Foglio1").Range("A2")
c2.Copy Worksheets("Foglio1").Range("B2")
c3.Copy Worksheets("Foglio1").Range("C2")

'REPLAY PER FOGLIO3
Sheets("Foglio3").Select
Set c1 = Range([A4], [A65536].End(xlUp))
Set c2 = Range([H4], [H65536].End(xlUp))
Set c3 = Range([O4], [O65536].End(xlUp))

c1.Copy Worksheets("Foglio1").Range("A65536").End(xlUp).Offset(1, 0)
c2.Copy Worksheets("Foglio1").Range("B65536").End(xlUp).Offset(1, 0)
c3.Copy Worksheets("Foglio1").Range("C65536").End(xlUp).Offset(1, 0)

Application.ScreenUpdating = True

End Sub

Ti ho commentato (con l’ “apostrofo”) Application.ScreenUpdating = False, che scommenterai quando avrai finito il debug del tuo codice.
Nella seconda parte ho usato il metodo End(xlUp) per trovare l’ ultima cella occupata e Offset(1,0) per spostarmi 1 riga sotto (cioe’ sulla prima cella libera).

Voila.

Fatti sentire, ciao.

Funziona perfettamente con i fogli visibili.
Nel mio caso all'apertura del file c'è questo:

Private Sub Workbook_Open()
Foglio2.Visible = xlSheetVeryHidden
Foglio3.Visible = xlSheetVeryHidden
End Sub

Come adeguare?

[VisitorsVBA]

Avrei pensato di fare in questo modo che ne dite?

Sub copiaincolla2()
Application.ScreenUpdating = False

Dim c1, c2, c3, Intervallo As Range
Foglio2.Visible = True
Sheets("Foglio2").Select
Set c1 = Range([A2], [A65536].End(xlUp))
Set c2 = Range([H2], [H65536].End(xlUp))
Set c3 = Range([O2], [O65536].End(xlUp))

c1.Copy Worksheets("Foglio1").Range("A65536").End(xlUp).Offset(1, 0)
c2.Copy Worksheets("Foglio1").Range("B65536").End(xlUp).Offset(1, 0)
c3.Copy Worksheets("Foglio1").Range("C65536").End(xlUp).Offset(1, 0)
Foglio2.Visible = xlSheetVeryHidden

'REPLAY PER FOGLIO3
Foglio3.Visible = True
Sheets("Foglio3").Select
Set c1 = Range([A4], [A65536].End(xlUp))
Set c2 = Range([H4], [H65536].End(xlUp))
Set c3 = Range([O4], [O65536].End(xlUp))

c1.Copy Worksheets("Foglio1").Range("A65536").End(xlUp).Offset(1, 0)
c2.Copy Worksheets("Foglio1").Range("B65536").End(xlUp).Offset(1, 0)
c3.Copy Worksheets("Foglio1").Range("C65536").End(xlUp).Offset(1, 0)
Foglio3.Visible = xlSheetVeryHidden

Application.ScreenUpdating = True

End Sub

[Anthony47]

Direi che va bene cosi'.

Ho visto che hai deciso di accodare i dati provenienti sia da Foglio2 che da Foglio 3 a quelli eventualmente gia' su Foglio1; se ti serve puoi azzerare l' area A:C tramite qualcosa come Range("A:C").ClearContents

Ciao