[Excel] Macro per copia-incolla range colonne progressivo

[Angi_86]

Ciao a tutti è il mio primo topic in questo forum, perdonatemi se farò qualche errore. Da poco tempo lavoro con le macro su Excel (2007) e finora me la sono cavata trovando soluzioni varie nel vostro forum, ma ora avrei bisogno del vostro aiuto, cerco di spiegarvi il mio problema.

Dovrei scrivere una macro che tramite ciclo considerasse tutte le colonne contenti una X. Ogni volta che trova la X deve:
1) copiare le formule contenute in un range di celle nella colonna della X e incollarle nella colonna successiva;
2) copiare le formule contenute nel medesimo range di celle della colonna precedente, a quella che contiene la X, e incollarle nella colonna contenente la X.

ESEMPIO



Ho bisogno che le formule in colonna C e in colonna I vadano rispettivamente in colonna D e in colonna J, poi che le formule in col B e in colonna H vadano rispettivamente in colonna C e in colonna I. Ogni mese io sposterò la X quindi il riferimento deve essere la X e i range di celle cambiare progressivamente.

Spero di essermi spiegata, non so se questo è fattibile, mi sareste di grande aiuto qualsiasi indicazioni possiate darmi.

[Flash30005]

Ciao Angi_86 e benvenuta nel Forum

Ma le formule hanno un riferimento relativo o assoluto?
E nel caso sia relativo devi spostare anche il loro puntamento?
es.: se C4 punta a B4 dopo spostamento a D4 deve puntare a C4 o sempre a B4?

ciao

P.s. dallo screenshot sembrano testi '2+2, '3+3

[Angi_86]

Ciao Flash 30005 grazie per la tempestiva risposta. Le formule non sono importanti (nemmeno i riferimenti che contengono: mi basta un "incolla speciale - formula"), in realtà il file originale è molto più complicato, qui ho esplicitato un esempio banale, il codice di cui ho bisogno è il ciclo con il riferimento alla colonna variabile che cambia nel tempo.
Ho bisogno di intercettare le colonne segnalate dalla X su riga fissa ed effettuare l'operazione descritta sopra nei 2 punti solo nel range di celle contenenti le formule (mantenendo l'intestazione delle colonne).

[Anthony47]

Penso che hai sottovalutato le domande di Flash... e io avrei anche chiesto quante righe sottostanti sarebbero da traslare.
Comunque:

Codice: Seleziona tutto

Sub xxx()
For Each Cell In Range("2:2")   '<<< Le X sono in riga 2?
    If UCase(Cell.Value) = "X" Then
        NRighe = Range(Cell, Cell.End(xlDown)).Rows.Count - 1
        Cell.Offset(1, -1).Resize(NRighe, 2).Copy
        Cell.Offset(1, 0).PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone
    End If
Next Cell
Application.CutCopyMode = False
End Sub


Questa macro controlla SU RIGA 2 la posizione delle X e poi fanno Copia /IncollaSpeciale-formule nelle colonne adiacenti.
Ho immaginato che le x siano solo su riga 2 ("Ho bisogno di intercettare le colonne segnalate dalla X su riga fissa"), e che le righe da copiare siano "tutte fino alla prima riga vuota". Eventualmente invece di For Each Cell In Range("2:2") usa For Each Cell In ActiveSheet.UsedRange per cercare in tutto il foglio; ed eventualmente spiega con quale regola determinare quante righe vanno copiate.
Il tutto e' da provare dopo aver fatto "due copie" di backup dei tuoi dati originali.

Fai sapere, ciao

[Flash30005]

Leggi quanto scritto da Anthony

Anche io ti invio una macro molto simile a quella di Anthony ma si limita a spostare solo le 3 righe nel riquadro
ad ogni X che trova nella riga 2

Codice: Seleziona tutto

Sub Spostadati()
Foglio = "Foglio1"
Worksheets(Foglio).Select
UC = Cells(2, Columns.Count).End(xlToLeft).Column
For CC = 1 To UC
    If UCase(Cells(2, CC).Value) = "X" Then
        Range(Cells(4, CC - 1), Cells(6, CC)).Copy
        Range(Cells(4, CC), Cells(6, CC + 1)).PasteSpecial Paste:=xlPasteFormulas
        Range(Cells(4, CC - 1), Cells(6, CC - 1)).ClearContents
    End If
Next CC
Application.CutCopyMode = False
End Sub

Ciao

[Angi_86]

Grazie infinite ad entrambi: mi avete risolto un grosso problema, alla fine ho usato il codice di Flash perchè il foglio è molto grosso ed è comodo lavori unicamente sul range di interesse.

Se posso ancora approfittarmi della vostra disponibilità avrei da chiedere due cose sul codice (lievemente adattato da quello di Flash), perchè mi piacerebbe imparare qualcosina in più sul VBA:

Sub UpdMonth()
Worksheets("TM1_a").Select
UC = Cells(10, Columns.Count).End(xlToLeft).Column 'COSA FA DI PRECISO?????
For CC = 1 To UC
If UCase(Cells(10, CC).Value) = "X" Then 'MA UCASE E' UNA VARIABILE COME UC DICHIARATA SOPRA O UNA FUNZIONE????
Range(Cells(19, CC), Cells(262, CC)).Copy
Range(Cells(19, CC + 1), Cells(262, CC + 1)).PasteSpecial Paste:=xlPasteFormulas
Range(Cells(19, CC - 1), Cells(262, CC - 1)).Copy
Range(Cells(19, CC), Cells(262, CC)).PasteSpecial Paste:=xlPasteFormulas
End If
Next CC
Application.CutCopyMode = False
End Sub

E un'ultima cosa: se volessi aggiungere l'istruzione che mi sposta di una casella a destra tutte le X (o più semplicemente l'intera riga che contiene le X) come potrei fare ipotizzando che debba farlo ogni mese?
Grazie, grazie, grazie per tutto il vostro tempo che mi dedicate.

[Flash30005]

Codice: Seleziona tutto

UC = Cells(10, Columns.Count).End(xlToLeft).Column

UC (variabile) assume il valore del numero colonne con dati a partire dalla colonna più a destra (in office 2003 dalla colonna "IV" verso sinistra quindi verso la colonna "A").
Il 10 si intende sulla riga 10
se in C10 hai una cella con un dato (valore numerico o stringa) UC sarà uguale a 3.

Ucase è una funzione che converte il testo in maiuscolo
Per evitare che errori di scrittura maiuscola o minuscola (x o X) possano non far accettare la condizione,
con Ucase qualsiasi sia il carattere il confronto lo farà con la "X" (maiuscola), in quanto lo converte (solo per il confronto)

Per l'ultimo quesito
puoi ottenere lo spostamento della X man mano che processi il foglio (vedi le 2 righe commentate)
oppure, se la X non occuperà mai la cella "A2", facendo slittare l'intera riga utilizzando il codice aggiunto alla fine (che lascio attivo)

Codice: Seleziona tutto

Sub Spostadati()
Foglio = "Foglio1"
Worksheets(Foglio).Select
UC = Cells(2, Columns.Count).End(xlToLeft).Column
For CC = 1 To UC
    If UCase(Cells(2, CC).Value) = "X" Then
        Range(Cells(4, CC - 1), Cells(6, CC)).Copy
        Range(Cells(4, CC), Cells(6, CC + 1)).PasteSpecial Paste:=xlPasteFormulas
        Range(Cells(4, CC - 1), Cells(6, CC - 1)).ClearContents
       ' Cells(2, CC).Cut Destination:=Cells(2, CC + 1)  '<<<<< commentata perché utilizza l'altro codice
       ' CC = CC + 1    '<<<<< commentata perché utilizza l'altro codice
    End If
Next CC
Application.CutCopyMode = False
Range("A2").Insert Shift:=xlToRight '<<<<< fa slittare l'intera riga verso destra
End Sub

Ciao

P.s. ieri avevo pensato di far slittare la X per evitare di perdere i dati (in colonna C e D) se attivi la macro per due volte consecutive.
ora non li perdi ma rischi di spostare ugualmente se, per errore, avvi la macro più volte.
Forse è il caso di inserire una sicurezza registrando la data di esecuzione macro
e se il mese è identico a quello di registrazione la macro non si attiva, cosa ne pensi?

[Angi_86]

Grazie mille Flash funziona tutto;
la sicurezza per la macro in effetti potrebbe essere utile, devo inserire un "if" di controllo all'inizio del codice?

Grazie ancora questa macro mi risparmia davvero molto lavoro.

[Flash30005]

Si ma con qualche accortezza

ti invio di nuovo la macro con indicate le righe aggiunte (ho visto che hai adattato la macro alle tue esigenze quindi...)

Codice: Seleziona tutto

Sub Spostadati()
Foglio = "Foglio1"
Worksheets(Foglio).Select
If Month(Range("A1").Value) <> Month(Now) Then  ' Condizione controllo mese
UC = Cells(2, Columns.Count).End(xlToLeft).Column
For CC = 1 To UC
    If UCase(Cells(2, CC).Value) = "X" Then
        Range(Cells(4, CC - 1), Cells(6, CC)).Copy
        Range(Cells(4, CC), Cells(6, CC + 1)).PasteSpecial Paste:=xlPasteFormulas
        Range(Cells(4, CC - 1), Cells(6, CC - 1)).ClearContents
        Range("A1").Value = Date   '<<<<<<<<<<<<<<<<< inserisce data in A1
        'Cells(2, CC).Cut Destination:=Cells(2, CC + 1)
        'CC = CC + 1
    End If
Next CC
Application.CutCopyMode = False
Range("A2").Insert Shift:=xlToRight
End If    '<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< Fine condizione mese
End Sub

Ciao

[Angi_86]

Grazie mille gentilissimo, forse sposterei solo l'inserimento della data attuale fuori dal ciclo for, più che altro perchè nel mio file ci sono parecchie "X" e dovrebbe quindi farlo molte volte.

Ti ringrazio per tutto l'aiuto che mi hai dato e complimenti per tutte le efficientissime risposte che dai ogni volta in questo forum, non sai quante volte mi è stato utile
Ciao

[Flash30005]

Si hai ragione

quindi prima dell'Endif (condizione data)

ciao

[Flash30005]

A questo punto rimane solo fare l'aggiornamento all'apertura del file
previo conferma quindi
nel vba di Thisworkbook (non nel modulo)
inserisci questo codice

Codice: Seleziona tutto

Private Sub Workbook_Open()
If Month(Worksheets("Foglio1").Range("A1").Value) <> Month(Now) Then
Messaggio = MsgBox(Prompt:="Vuoi Aggiornare a questo mese ?", Buttons:=vbYesNo)
If Messaggio = 6 Then Call Spostadati
End If
End Sub


Quando aprirai il foglio se il mese di A1 del "Foglio1" (cambia il nome del foglio se diverso)
è diverso dal mese attuale appare un messaggio che chiede conferma se aggiornare o no

ciao