incolla valori discontinui

[miko]

salve,
ho realizzato la seguente macro per copiare i valori dispoti su colonne adiacenti ma su righe discontinue, 1 riga piena ogni 2 righe vuote, ed incollarli in altre celle aventi la stessa disposizione del range di partenza:

Codice: Seleziona tutto

Sub INCOLLA_VAL()
'evita saltellamenti (scrolling) a schermo
Application.ScreenUpdating = False
Application.Calculation = xlManual
 Application.Cursor = xlWait
'dichiarazioni delle variabili come Range
Dim R1, R2, R3, R4, R5, R6, R7, R8, R9
Dim C1, C2, C3, C4, C5, C6, C7, C8, C9
Dim Intervallo1 As Range, Intervallo2 As Range
With Sheets("Foglio1")
Set R1 = Range("C4:N4") 
Set R2 = Range("C7:N7")
Set R3 = Range("C10:N10")
Set R4 = Range("C13:N13") 
Set R5 = Range("C16:N16")   
Set R6 = Range("C19:N19")
Set R7 = Range("C22:N22")
Set R8 = Range("C25:N25")
Set R9 = Range("C28:G28")
Set C1 = Range("Q4:AB4")
Set C2 = Range("Q7:AB7")
Set C3 = Range("Q10:AB10")
Set C4 = Range("Q13:AB13") 
Set C5 = Range("Q16:AB16")   
Set C6 = Range("Q19:AB19")
Set C7 = Range("Q22:AB22")
Set C8 = Range("Q25:AB25")
Set C9 = Range("Q28:U28")
End With
Set Intervallo1 = Union(R1, R2, R3, R4, R5, R6, R7, R8, R9)
Set Intervallo2 = Union(C1, C2, C3, C4, C5, C6, C7, C8, C9)
Intervallo1.Select
 Selection.Copy ********************
 Intervallo2.Select
 Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:= _
        False, Transpose:=False
    Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
  Application.CutCopyMode = False
  Application.Calculation = xlCalculationAutomatic
 Application.ScreenUpdating = True
 Application.Cursor = xlDefault
    Range("A1").Select
End Sub

la macro si blocca in corrispondenza della linea asteriscata.
quali sono le modifiche da apportare per ottenere il copia-incolla?
ciao grazie

[Anthony47]

Il debugger ti dice che non puoi eseguire il comando su una selezione multipla.
Devi quindi crearti una macro che copia e incolla una selezione alla volta.

Ad esempio puoi crearti un array in cui inserisci alternativamente i singoli range da copiare le cell di destinazione.
Poi usi un loop per pelevare i valori dall' array ed esegui la singola Copia & Incolla.
Qualcosa come

Codice: Seleziona tutto

Arr = Array("C4:N4", "Q4", "C7:N7", "Q7", ETC ETC)
'.. .
For I=0 to XYZ step 2 'xyz=N° di elementi -1
Range(Arr(I).Copy
Range(Arr(I+1).PasteSpecial Paste:= etc etc
' etc
Next I
'etc


Se i dati sono spaziati regolarmente (come mi sembra di capire, 1 riga da copiare e 2 da saltare), puoi anche organizzare il loop usando I*3 come offset di riga.

E se hai dubbi posta ancora.

Ciao

[miko]

salve,
in effetti il debugger mi dice proprio quello da te indicato.
più che dubbi ho difficoltà nel comprendere il procedimento da te suggerito.
non ho mai usato gli array e gli argomenti relativi mi sono sembrati difficili;
inoltre non comprendo

...puoi anche organizzare il loop usando I*3 come offset di riga

puoi completare la macro con le linee mancanti?
forse riesco a creare la macro

che copia e incolla una selezione alla volta

quella con gli array sarebbe di buon studio per me data la conoscenza del suo ambito di applicazione
ciao grazie

[Anthony47]

La macro e' poco piu' di quello che ti ho gia' scritto.

Codice: Seleziona tutto

Sub pippo()
Arr = Array("C4:N4", "Q4", "C7:N7", "Q7", ETC ETC)   '<<< Qui completala tu
For I=0 to 19 step 2
Range(Arr(I)).Copy
Range(Arr(I+1)).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:= _
        False, Transpose:=False
Range(Arr(I+1)).PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
  Application.CutCopyMode = False
Next I
End Sub


Devi completare l' istruzione marcata <<<, inserendo con quella sintassi alternativamente l' intervallo da copiare e la cella di destinazione (basta la cella di partenza, non serve tutto l' intervallo).

Quando ti funziona la puoi abbellire con ScreenUpdating, Cursor, Calculation; sempre che ne veda il bisogno.

Ciao

[miko]

salve,
grazie funziona perfettamente;
mi sono incuriosito: come dovrei modificare la macro se si considera un numero elevato
di righe discontinue?
immagino che dovrei considerare un ciclo che faccia variare la linea
Arr = Array("C4:N4", "Q4", "C7:N7", "Q7", ETC ETC)
ma come si imposta?
e poi in questo caso bisogna calcolare anche il valore massimo della variabile I
per il ciclo:
For I=0 to 19 step 2
ciao grazie

[Anthony47]

Se hai tantissimi intervalli allora dovrai caricare tantissime coppie di dati in Varr; poi, per evitare di contare a occhio quanti dati hai inserito userai

Codice: Seleziona tutto

For I=0 to UBound(Arr)


Se gli incrementi sono regolari, allora puoi anche provare a usare il metodo di "organizzare il loop usando I*3 come offset di riga"; ad esempio

Codice: Seleziona tutto

For I=0 to XYZ step 1 'xyz=N° di range da copiare -1
Range("C4:N4").offset(I*3,0).Copy
Range("Q4").offset(I*3,0).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:= _
        False, Transpose:=False
Range("Q4").offset(I*3,0).PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
Next I


Questo esempio presuppone che copierai da C4:N4 in Q4 e poi N volte le stesse celle ma spaziate di 3 righe verso il basso.

Ciao

[miko]

ciao,
ho provato le due versioni di codice, ovviamente funzionano;
mi sembra di capire che non esiste un metoto più veloce per inserire i dati in
Arr = Array("C4:N4", "Q4", "C7:N7", "Q7", ETC ETC),
se non manualmente ed usando UBound(Arr) nel ciclo;
allora è più immediato il secondo codice nel quale ho notato, provando la macro con varie modifiche, che non è necessario specificare il numero xyz=N° di range da copiare, ma basta inserire un valore massimo che comprenda i range che si intendono copiare;
naturalmente se oltre tale valore non ci sono dati non sarà copiato nulla.
grazie per le macro e le spiegazioni.
saluti