Ancora una procedura per Copiare/Incollare

Utilizzo : Copia/Incolla dati in celle NON contigue con destinazione in celle contigue.

ovvero: copia dei nuovi dati inseriti nella prima riga libera di un elenco, non tutte le celle, ed incollaggio su una tabella elenco posta su un altro foglio.

La procedura si basa sulla necessità di NON copiare tutte le celle di un elenco, ma solo alcune, e di ricostruire un nuovo elenco in altra zona, con i dati inseriti in celle contigue per successivi conteggi. Il codice cerca l'ultima riga dell'elenco nel quale sono stati inseriti i nuovi dati, seleziona le celle che devono essere copiate, si sposta sul foglio di destinazione, nel quale sono state definite le celle iniziali, qui cerca la prima riga libera, e "scarica" (incolla) i dati copiati. La procedura esegue il "copia/Incolla" una cella per volta, selezionando alternativamente il foglio con la cella da copiare e quindi il foglio con la cella dove incollare, ma grazie all'istruzione : Application.ScreenUpdating = False , non si notano saltellamenti. Questa è la routine:

Sub copiazza()
'I caratteri in verde, dopo l'apice, sono commenti
'e se vuoi li puoi togliere.

Application.ScreenUpdating = False
Worksheets("Foglio1").Select
Range("A4").Select

Selection.End(xlDown).Select
Selection.Copy 'copio il nome (1° colonna partendo dalla B)

Worksheets("Foglio2").Select ' seleziono il foglio2
Range("B5").Select
Selection.End(xlDown).Select
ActiveCell.Offset(1, 0).Select 'trovo la prima cella libera
'nella colonna B, la seleziono e incollo
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
'------------------------------
Worksheets("Foglio1").Select 'poi torno sul foglio1
Range("A4").Select
Selection.End(xlDown).Select
ActiveCell.Offset(0, 1).Select 'copio la data (2° cella 2° colonna dell'elenco)
Selection.Copy

Worksheets("Foglio2").Select 'torno sul foglio2
Range("B5").Select
Selection.End(xlDown).Select 'vado alla cella ultima occupata
ActiveCell.Offset(0, 1).Select 'seleziono la colonna accanto
'e incollo
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
'-------------------------------
Worksheets("Foglio1").Select
Range("A4").Select
Selection.End(xlDown).Select
ActiveCell.Offset(0, 3).Select 'copio il primo valore (4° cella 4°colonna)
Selection.Copy

Worksheets("Foglio2").Select
Range("B5").Select
Selection.End(xlDown).Select
ActiveCell.Offset(0, 2).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
'--------------------------------
Worksheets("Foglio1").Select
Range("A4").Select
Selection.End(xlDown).Select
ActiveCell.Offset(0, 5).Select 'copio il secondo valore (6°cella 6°colonna)
Selection.Copy

Worksheets("Foglio2").Select
Range("B5").Select
Selection.End(xlDown).Select
ActiveCell.Offset(0, 3).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
'--------------------------------
Worksheets("Foglio1").Select
Range("A4").Select
Selection.End(xlDown).Select
ActiveCell.Offset(0, 8).Select 'copio il terzo valore (9° cella 9a colonna)
Selection.Copy

Worksheets("Foglio2").Select
Range("B5").Select
Selection.End(xlDown).Select
ActiveCell.Offset(0, 4).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
'-------------------------------
Worksheets("Foglio1").Select

Application.CutCopyMode = False 'questo evita i trattini intorno alla/alle
'celle copiate

End Sub

I riferimenti alle celle di inizio elenco e di inizio destinazione si capiscono meglio se scaricherete il file allegato. la procedura, anche se appare lunga, è semplice, e si ripete tante volte quante sono le celle da copiare. Sotto due immagini, il foglio1 con l'elenco in cui si inseriscono i dati, ed il foglio2 con le destinazioni.