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

In che punto?

Così dà errore sintassi

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

Scusami ma sto in confusione

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

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.

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
`

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"