› Excel e gli applicativi Microsoft Office › Macro per aggiungere più righe alla volta per più fogli (Excel)
-
AutoreArticoli
-
Può essere che basti cambiare il riferimento delle celle da Assoluto a Relativo (togliere il simbolo $ prima del numero del rigo per interni).
La formula è già in "relativo". Come avete notato io non so niente di VBA, di conseguenza non ho capito molto di quello che hai scritto nel codice, ma vedendolo al lavoro (attivandolo) è come se avesse spostato la quarta riga giù e non copiata ed incollata. Nel senso che se la copi e poi la incolli, la formula dovrebbe cambiare i riferimenti da sola; in questo caso non li ha cambiati e quindi suppongo che il codice sposti la quarta riga, ma non il copia ed incolla.
In allegato il file originale (con l'ultimo codice delle 3 righe)
Allegati:
You must be logged in to view attached files.Dunque...ho visto meglio il file e devo dire che è un gran casino...almeno per me che ovviamente non conosco il tipo di lavoro che deve eseguire. Cmq ci sono tanti riferimenti a range di celle in fogli secondari ho visto. Sono stati definiti dei Riferimenti per poi essere richiamati. Cmq ti giro una nuova versione. Tieni presente una cosa. La cella P6 che contiene la formula del Cerca.Vert...se crei con la mia nuova Sub CopiaIncollaRighe succede come hai chiesto, cioè che scala sotto l'ultimo rigo. Ma se vuoi tornare indietro, eliminando le righe appena copiate, quella formula non muta la cella di riferimento in P6. Se vuoi che sia così penso bisogna agire tramite codice VBA.
Option Explicit Sub CopiaIncollaRighe() Dim iUltimaRiga As Long '-----a patto che i 2 fogli rispettano le stesse righe di partenza, altrimenti bisogna aggiungere un altra variabile per il secondo foglio Dim rRigheCopiate As Range Dim iClear As Integer Dim s As String Application.ScreenUpdating = False '-----CopiaIncolla righe nel foglio1 Sheets("Operatore").Activate '<<<<<-----inserisci il nome esatto del foglio tra le virgolette (e poi non cambiarlo più!) iUltimaRiga = Range("A" & Rows.Count).End(xlUp).Row If iUltimaRiga > 4 Then '-----Copio dal primo fino al rigo dove c'è la formula Cerca.Vert--->(Rows(iUltimaRiga + 1)) Set rRigheCopiate = Range(Rows(iUltimaRiga - 2), Rows(iUltimaRiga + 1)) Else MsgBox "E' necessario che nella cella 'A5' ci sia un valore simbolico", vbInformation, "Errore" Exit Sub End If '-----Incollo le righe copiate a partire dal rigo dov'è presente la cformula Cerca.Vert With rRigheCopiate.Select Selection.Copy Rows(iUltimaRiga).Select Range("A" & iUltimaRiga + 1).PasteSpecial Application.CutCopyMode = False End With Cells(iUltimaRiga + 4, 2).Select '-----CopaiIncolla righe nel foglio7 Sheets("A.F._2").Activate '<<<<<-----inserisci il nome esatto del foglio tra le virgolette (e poi non cambiarlo più!) iUltimaRiga = Range("A" & Rows.Count).End(xlUp).Row If iUltimaRiga > 4 Then Set rRigheCopiate = Range(Rows(iUltimaRiga - 2), Rows(iUltimaRiga)) Else MsgBox "E' necessario che nella cella 'A5' ci sia un valore simbolico", vbInformation, "Errore" Exit Sub End If With rRigheCopiate.Select Selection.Copy Range("A" & iUltimaRiga + 1).PasteSpecial Application.CutCopyMode = False End With Cells(iUltimaRiga + 4, 4).Select '---cancellazione nelle celle da C-P; R-X; Z-AC '---(suggerito da Vecchio_Frac che ringrazio) With Worksheets("Operatore") '<<<<<-----inserisci il nome esatto del foglio tra le virgolette (e poi non cambiarlo più!) .Select iClear = iUltimaRiga + 3 s = Replace("C%i:P%i, R%i:X%i, Z%i:AC%i", "%i", iClear) Range(s).ClearContents End With Application.ScreenUpdating = True End SubAllegati:
You must be logged in to view attached files.Funziona benissimo @alexps81, grazie mille per tutto. Grazie anche a te @vecchio_frac. Se cancello le righe, la cella con il "cerca.vert" perde il riferimento, ma non è un problema in quanto non dovrebbe esserci la necessita di eliminare le righe. Avrei ancora solo una domanda:
Io vorrei mettere il codice per togliere e rimettere la protezione dei fogli "Operatore" e "A.F._2" e vorrei capire se va bene scriverlo in questo modo:
Option Explicit Sub CopiaIncollaRighe_2() Dim iUltimaRiga As Long '-----a patto che i 2 fogli rispettano le stesse righe di partenza, altrimenti bisogna aggiungere un altra variabile per il secondo foglio Dim rRigheCopiate As Range Dim iClear As Integer Dim s As String Application.ScreenUpdating = False Worksheets("Operatore").Unprotect "Password" Worksheets("A.F._2").Unprotect "Password" '-----CopiaIncolla righe nel foglio1 Sheets("Operatore").Activate '<<<<<-----inserisci il nome esatto del foglio tra le virgolette (e poi non cambiarlo pi�!) iUltimaRiga = Range("A" & Rows.Count).End(xlUp).Row If iUltimaRiga > 4 Then '-----Copio dal primo fino al rigo dove c'� la formula Cerca.Vert--->(Rows(iUltimaRiga + 1)) Set rRigheCopiate = Range(Rows(iUltimaRiga - 2), Rows(iUltimaRiga + 1)) Else MsgBox "E' necessario che nella cella 'A5' ci sia un valore simbolico", vbInformation, "Errore" Exit Sub End If '-----Incollo le righe copiate a partire dal rigo dov'� presente la cformula Cerca.Vert With rRigheCopiate.Select Selection.Copy Rows(iUltimaRiga).Select Range("A" & iUltimaRiga + 1).PasteSpecial Application.CutCopyMode = False End With Cells(iUltimaRiga + 4, 2).Select '-----CopaiIncolla righe nel foglio7 Sheets("A.F._2").Activate '<<<<<-----inserisci il nome esatto del foglio tra le virgolette (e poi non cambiarlo pi�!) iUltimaRiga = Range("A" & Rows.Count).End(xlUp).Row If iUltimaRiga > 4 Then Set rRigheCopiate = Range(Rows(iUltimaRiga - 2), Rows(iUltimaRiga)) Else MsgBox "E' necessario che nella cella 'A5' ci sia un valore simbolico", vbInformation, "Errore" Exit Sub End If With rRigheCopiate.Select Selection.Copy Range("A" & iUltimaRiga + 1).PasteSpecial Application.CutCopyMode = False End With Cells(iUltimaRiga + 4, 4).Select '---cancellazione nelle celle da C-P; R-X; Z-AC '---(suggerito da Vecchio_Frac che ringrazio) With Worksheets("Operatore") '<<<<<-----inserisci il nome esatto del foglio tra le virgolette (e poi non cambiarlo pi�!) .Select iClear = iUltimaRiga + 3 s = Replace("C%i:P%i, R%i:X%i, Z%i:AC%i", "%i", iClear) Range(s).ClearContents Worksheets("Operatore").Protect "Password" Worksheets("A.F._2").Protect "Password" End With Application.ScreenUpdating = True End SubE' ovvio che le celle che il codice cancella non sono protette proprio per dare la possibilità di compilarle anche quando il foglio è protetto.
Buona giornata
Domani appena posso gli do uno sguardo. Quindi i fogli sono protetti...ok ok
Esiste anche un metodo per poter definire una o più aree del foglio da manipolare. Devi intercettare l'evento Change del foglio ed utilizzare la funzione "Intersect" sul Target.
Cmq domani vedo.
Io ho provato a fare come ho scritto sopra e sembra anche funzionare. Di fatti il blocco è messo con la possibilità di selezionare e compilare le celle che sono state formattate senza lo blocco della cella. Di conseguenza, copiando la riga sopra, copia anche i formati e, quindi, anche il fatto che le celle che devo compilare possono essere compilate senza problemi.
L'unica cosa è che se c'è un modo più bello e più efficace..
Io ho provato a fare come ho scritto sopra e sembra anche funzionare. Di fatti il blocco è messo con la possibilità di selezionare e compilare le celle che sono state formattate senza lo blocco della cella. Di conseguenza, copiando la riga sopra, copia anche i formati e, quindi, anche il fatto che le celle che devo compilare possono essere compilate senza problemi.
Ok sono riuscito finalmente a dare uno sguardo al tuo file. Diciamo che per il tuo scenario, il metodo Sproteggi/Proteggi oltre ad essere indispensabile per la Sub Copia/Incolla si rende anche efficace per la manipolazione dei valori nelle celle interessate.
Inizialmente pensavo che avessi reso Sbloccate tutte le celle sotto in corrispondenza di queste. A quel punto era meglio intraprendere la strada dell'intercettazione del target. Cioè una funzione (Intersect) nel Worksheet che andasse a rendere manipolabili tutte quelle celle presenti in un intervallo da te definito (che ovviamente di volta in volta sarà sempre più ampio visto che aggiungi righe sotto).
Qualcosa tipo questo:
`Option Explicit Private Sub Worksheet_SelectionChange(ByVal Target As Range) Dim rng As Range Set rng = Range("A1:C10") If Not Intersect(Target, rng) Is Nothing Then ActiveSheet.Unprotect Else ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True End If End Sub `Cioè se nelle celle che vanno da A1 a C10 ci entri allora puoi modificarle altrimenti se (il target) sei fuori si protegge il foglio e non puoi più modificare.
Tu ovviamente avresti dovuto modificarla questa sub adeguando il Range rnd in modo dinamico.
Cmq come hai fatto tu va bene.
Buongiorno,
voglio ringraziare per tutto quello che avete fatto fino ad adesso e vorrei chiedervi se potete aiutarmi per un problema che ho adesso, cioè che si aggiungono le righe solo del primo foglio "Operatore", ma dell'ultimo "A.F._2" no. In più non si cancellano le celle che ho selezionato (per il primo foglio). Vorrei capire com'è possibile dato che il codice è lo stesso dell'altra volta (che funzionava benissimo la scorsa volta).
Il codice che ho utilizzato è quello della domanda #41534. Di seguito allego il file con il codice integrato.
----------------------------
Ricordo che il primo foglio ha 4 righe, ma devono essere copiate e aggiunte solo le prime tre, in quanto la quarta dev'essere solamente spostata sotto le nuove tre righe che vengono aggiunte --> questo perchè l'ultima riga utilizza la formula con riferimento all'ultima riga e basta. L'ultimo foglio ha solo 3 righe, di conseguenza vengono aggiunte/copiate tutte tre le righe. Solamente il primo foglio ha bisogno di cancellare le celle (specificate nel codice), perchè il secondo foglio ha solo formule.
----------------------------
Grazie per tutto e buona giornata
Allegati:
You must be logged in to view attached files.Benedetta è la password per tutti i fogli, mà per Operatore ed A.F._2 è differente
Per gli altri 2 fogli la password è "Password", mi sono dimenticato di sostituirlo nel file.
Devi provare con le password giuste, se funzionava prima....dovrebbe funzionare
-
AutoreArticoli
