copia incolla righe tra fogli

[frank_ciccioPartecipante frank_ciccio]

Ciao.
Nel workbook allegato ci sono 2 macro per copiare/incollare righe tra 2 fogli.

La macro in modulo11
Sub archivia_1()
copia le righe selezionate da foglio "produttività" in foglio "archivio_altri"

La macro in modulo16
Sub archivia_1_input()
copia le righe selezionate da foglio "input" in foglio "archivio_input"

nel copia incolla le macro tolgono le convalida_dati e colori di sfondo presenti lasciando le formattazioni.

per incolla le righe selezionare una riga e cliccare nel pulsante "archivia una riga selezionata"

Il copia incolla della macro
Sub archivia_1_input()
funziona esatto.

il copia incolla della macro
Sub archivia_1()
non incolla la formattazione esatta, ma spostata.

La differenza tra i due fogli "archivio" è che nel foglio "archvio_altri" c'è una colonna in più A e quindi
non incolla esatto, deve incollare nella colonna B.
Spero di essermi spiegato

Allegati:

You must be logged in to view attached files.

[LucaSRPartecipante LucaSR Karma: 15 pts]

In questo caso ti conviene estrarre non la riga intera ma la porzione di riga usata, creando un range che vada dalla prima cella usata all'ultima e poi incollarla nel foglio dalla seconda colonna.

Mi spiego meglio, invece di usare EntireColumns per l'intera riga dovresti usare Range(prima cella, ultima cella a destra) tramite il metodo End, questo se tutte le celle sono contigue.

[frank_ciccioPartecipante frank_ciccio]

Copia già il range

Range("A" & n & ":P" & n).Copy 'copia range

[frank_ciccioPartecipante frank_ciccio]

Probablimente bisogna modificare qui

For i = 5 To 65536 'incolla dalla riga 4
If ActiveSheet.Cells(i, 2) = vbNullString Then
ActiveSheet.Cells(i, 2).Select

Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:=False, Transpose:=False '<<< a colori

[LucaSRPartecipante LucaSR Karma: 15 pts]

Dopo scrivi 

Destination:=prima cella

Prima cella del nuovo foglio partendo dalla colonna B

[frank_ciccioPartecipante frank_ciccio]

In che punto?

[LucaSRPartecipante LucaSR Karma: 15 pts]

Subito dopo il Copy, spazio Destination...

Edit:

Esegui un ciclo di 65K di righe?? Hai effettivamente tutti questi dati?

[frank_ciccioPartecipante frank_ciccio]

Così dà errore sintassi

Range("A" & n & ":P" & n).Copy Destination:= prima cella 'copia range

[LucaSRPartecipante LucaSR Karma: 15 pts]

Sei serio?? 🤔

Prima cella dovrà essere la prima cella del foglio in cui vuoi copiare 

[frank_ciccioPartecipante frank_ciccio]

Scusami ma sto in confusione

[frank_ciccioPartecipante frank_ciccio]

Ma così non incolla sulla seconda colonna ?

For i = 5 To 65536 'incolla dalla riga 4
If ActiveSheet.Cells(i, 2) = vbNullString Then
'ActiveSheet.Cells(i, 2).Select

ActiveSheet.Cells(i, 2)ActiveSheet.Cells(i, 2.PasteSpecial Paste:=xlPasteAll ', Operation:=xlNone, SkipBlanks:=False, Transpose:=False '<<< a colori
'Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False '<<< solo valori

[frank_ciccioPartecipante frank_ciccio]

Il problema è che dopo il copia incolla da range A:P del foglio "produttività" a range B:Q del foglio "archivio_produttività" i riferimenti restano uguali.

Esempio le  formattazioni celle J:K foglio produttività devono essere uguali a celle K:L del foglio "archivio_produttività" ma i riferimenti non cambiano

[LucaSRPartecipante LucaSR Karma: 15 pts]

La formattazione devi prepararla prima nel foglio che ospiterà i nuovi valori, ad esempio testo/numeri/date.

Poi quando crei la macro di copia del Range dal foglio iniziale, prima crei il range da copiare e dopo lo incolli nella prima cella disponibile nel foglio di destinazione, che nel tuo caso parte dalla colonna B

[frank_ciccioPartecipante frank_ciccio]

Il problema è che ho vari fogli con formattazioni diverse. Per non preparare le formattazioni in tutti i fogli di destinazione come i fogli di partenza, pensavano ci fosse qualcosa che copiasse da colonna A a colonna B con gli stessi riferinenti.

[alexps81Moderatore alexps81 Karma: 55 pts]

Ciao @frank_ciccio

scusa se insisto, ma già in un altro Thread avevo anche io esaminato questo tuo progetto e, ahimè malgrado la tua volontà di portare a termine il lavoro, ti avevo consigliato di rivederlo da cima a fondo perché ci sono tanti errori di fondo. Te ne riporto giusto uno che creerebbe tanti di quei problemi tanti da farti uscir di matto:

in una delle routine presenti nei moduli, lanci l'istruzione Application.EnabledEvents = False poi, mentre il codice fa il suo decorso, ci sono delle condizioni che se per caso non vengono soddisfatte scatta un bellissimo (o bruttissimo...dipende) Exit Sub. Secondo te cosa succede da quel momento in poi? Io penso che gli eventi non ripartono più.

Poi ci sono altri errori più o meno gravi...ma elencarli tutti si fa notte. Io te lo dico perché mi dispiacerebbe che tu perdessi tanto tempo per provare a risolvere un problema quando poi dopo se ne presenterebbero altri dieci...e magari non puoi risolverli tanto facilmente ma dovresti stravolgere tutto il codice creato fin ora. Il problema è che darti una mano a rifarlo daccapo vuol dire creare un progetto dalla A alla Z e purtroppo, malgrado io ti aiuterei volentieri, non sarebbe giusto. Mi dispiace dirti queste cose e non vorrei ci rimanessi male, ma anche io anni fa, ancora acerbo di conoscenze, incappavo in errori tali.

 

[frank_ciccioPartecipante frank_ciccio]

Ho tolto

Application.EnabledEvents = False 

e alcuni

if... exit sub.

Ora la macro (penso) copia incolla e basta, ma non cambia nulla.

Penso che la colpa che dopo il copia incolla da i riferimenti della formattazione si sballano

Una mia curiosità c'è un modo per copiare incollare solo i colori della formattazione che è quello che mi interessa?

 

`Sub archivia_1_no_input(nomeFile As String)
'per fogli action non input

'Application.EnableEvents = False
Application.ScreenUpdating = False
ActiveSheet.Unprotect "987654"



Dim n, i, x, nc As Long
Dim avviso, Avviso2 As String
Dim cella_attiva As String
Dim nome1 As String
Dim fogl1 As String


'cella_attiva = Cells(ActiveWindow.RangeSelection.Row, 1).Value
nome1 = ActiveSheet.Name

avviso = MsgBox("Archivio il contenuto della < riga " & ActiveCell.Row & " / nr. " & cella_attiva & " > selezionata?. " & Chr(13) & _
"La riga verrà archiviata nel foglio < Archivio_altri > ", vbYesNo + vbQuestion, "AVVISO")
If avviso = vbNo Then Exit Sub



If avviso = vbYes Then
n = ActiveCell.Row
If n < 7 Then



MsgBox ("Le prime 6 righe non si possono archiviare"), vbCritical, ("ATTENZIONE!")
Exit Sub
Else
'Application.EnableEvents = False

'-------------------------------------------------------------------------
 Sheets("archivio_altri").Select 'sprotegge archivio
 ActiveSheet.Unprotect "987654"
 
 'Sheets("sicurezza").Select 'passa all'altro foglio
 Sheets(nomeFile).Select 'passa all'altro foglio
 
 'Rows(n).EntireRow.Copy 'copia riga
 Range("A" & n & ":P" & n).Copy  'copia range
 
 
 'If Range("A" & n) = "" Then
 'avviso = MsgBox("La riga < " & ActiveCell.Row & " > è vuota! " & Chr(13) & _
        "Seleziona una riga non vuota.", vbOKOnly + vbCritical, "AVVISO")
 'ActiveSheet.Protect "987654"
 'Application.CutCopyMode = False
 'Exit Sub
 'End If
 
 
 Sheets("archivio_altri").Select 'ritorna all'archivio

For i = 5 To 65536 'incolla dalla riga 4
If ActiveSheet.Cells(i, 2) = vbNullString Then
ActiveSheet.Cells(i, 2).Select

'ActiveSheet.Paste
'Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        ':=False, Transpose:=False
        


Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:=False, Transpose:=False '<<< a colori
'Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False '<<< solo valori
Range(Cells(i, 1), Cells(i, 17)).Validation.Delete
Range(Cells(i, 1), Cells(i, 17)).Interior.Color = xlNone
Range(Cells(i, 18), Cells(i, 18)).Interior.Color = xlNone ' Colora da A a Q
 
If ActiveSheet.Cells(i, 17) <> "" Then
Range(Cells(i, 1), Cells(i, 17)).Validation.Delete
Range(Cells(i, 1), Cells(i, 17)).FormatConditions.Delete
Range(Cells(i, 1), Cells(i, 17)).Interior.Color = RGB(153, 255, 153) ' Colora da A a Q
End If



 
 'Sheets("archivio_altri").Select 'riprotegge l'archivio
' Range("B5:R500").Select
' Selection.Locked = True
' ActiveSheet.Protect "987654"
'ActiveSheet.Protect Password:="987654", DrawingObjects:=True, Contents:=True, Scenarios:=True _
        , AllowFormattingCells:=False, AllowInsertingHyperlinks:=False, AllowFiltering:=True
        
        
        
'[A4].Select
ActiveSheet.Cells(i, 1).Select 'seleziona cella 1 nuova riga inserita
Application.CutCopyMode = False

Exit For
End If
Next i

  

 'Sheets("sicurezza").Select 'ritorna all'altro foglio
 Sheets(nomeFile).Select 'passa all'altro foglio
 
fogl1 = ActiveSheet.Name

Sheets("archivio_altri").Unprotect "987654"
Sheets("archivio_altri").Cells(i, 1) = fogl1 'seleziona cella 1 nuova riga inserita
Sheets("archivio_altri").Protect "987654"
 
 
'-------------------------------------------------------------------------
 
'Call EliminaRiga_2

   'Application.CutCopyMode = False
   
'-----------------------------------------------------------------------

End If
End If

'[A6].Select
'Rows(n).Select 'seleziona riga

'On Error Resume Next
Cells(n, 1).Select        '<-- nuova riga inserita


'ActiveSheet.Protect "987654"
'ActiveSheet.Protect Password:="987654", DrawingObjects:=True, Contents:=True, Scenarios:=True _
       , AllowFormattingCells:=False, AllowInsertingHyperlinks:=False, AllowFiltering:=True
      

'Application.EnableEvents = True
Application.ScreenUpdating = True


'Foglio2.Range("A6").Value = "1"
'Foglio2.Range("A7").Value = "1"


 
End Sub
`

 

[frank_ciccioPartecipante frank_ciccio]

Probabilmente ci sarà qualcosa di più semplice.

Ho fatto così:

Nella macro "Sub archivia_1_no_input(nomeFile As String)" ho aggiunto 2 macro una che aggiunge una colonna A poi un'altra che elimina questa colonna nel foglio "produttività"
La macro "Sub archivia_1_no_input(nomeFile As String)" ora copia incolla esatto come colori formattazione.

 

Allegati:

You must be logged in to view attached files.

[frank_ciccioPartecipante frank_ciccio]

Ciao,

la macro che ho modificato inserendo una nuova colonna funziona benino.

Durante il "lavoro" della macro si visualizza la creazione e l'eliminazione della colonna A.

All'inizio e alla chiusura delle macro in modulo11 "Sub archivia_1_no_input(nomeFile As String)" c'è

Application.ScreenUpdating = False

Application.ScreenUpdating = true

ma serve a poco.

Probabilmente è colpa anche delle altre macro richiamate con "Call" sempre dentro alla macro in modulo11.

Il lavoro  è probabilmente  un pò incasinato ma non è mio ma l'ho eriditato da un collega.

E' possibile almeno non visualizzare la colonna A quano viene creata e annullata?

Per provare nel foglio "produttivita" selezionare una riga e poi cliccare nel pulsante "archivia 1 riga selezionata"

 

Allegati:

You must be logged in to view attached files.

[Autore]

Articoli