You are here:--copia incolla dati e nomi saltando alcune righe
copia incolla dati e nomi saltando alcune righe 2018-11-01T16:52:45+00:00

Home Forum Domande su Excel VBA e MACRO copia incolla dati e nomi saltando alcune righe

  • Autore
    Articoli
  • DOMENICO04
    Partecipante
      Post totali: 16
      #7032 |

      salve qualcuno può aiutarmi a modificare questo codice facendo si che si riduca in poche righe?

      in pratica copia dei nomi e numeri che sono nelle prime colonne del foglio e le incolla in successione.
      le colonne da copiare e incollare sono 14, poi lascia uno spazio vuoto di due colonne, tranne all’inizio che ne lascia 6.
      questo lavoro deve farlo per tutte le colonne finche non finisce il foglio excel.
      io l’ho fatto con la “registrazione macro”

      ma il codice diventa lunghissimo.

      non sono capace di accorciarlo, ho messo questo quesito in altri forum ma non mi hanno risposto.

      allego prima il codice da accorciare poi allego il codice completo e metto un file di esempio.

      grazie.

      codice da modificare

      Application.DisplayAlerts = False
      Sheets("stampa movimenti").Select 'copia i movimenti di 15 giorni prima per lasciarti una copia in caso servisse
      Range("sr1:if2489").Select
      Selection.Copy
      Range("ii1").Select
      ActiveSheet.Paste
      
      Sheets("stampa movimenti").Select 'copia i movimenti di 15 giorni prima per lasciarti una copia in caso servisse
      Range("sb1:so2489").Select
      Selection.Copy
      Range("sr1").Select
      ActiveSheet.Paste
      
      Sheets("stampa movimenti").Select 'copia i movimenti di 15 giorni prima per lasciarti una copia in caso servisse
      Range("rl1:ry2489").Select
      Selection.Copy
      Range("sb1").Select
      ActiveSheet.Paste
      
      Sheets("stampa movimenti").Select 'copia i movimenti di 15 giorni prima per lasciarti una copia in caso servisse
      Range("qv1:ri2489").Select
      Selection.Copy
      Range("rl1").Select
      ActiveSheet.Paste
      
      Sheets("stampa movimenti").Select 'copia i movimenti di 15 giorni prima per lasciarti una copia in caso servisse
      Range("qf1:qs2489").Select
      Selection.Copy
      Range("qv1").Select
      ActiveSheet.Paste
      
      Sheets("stampa movimenti").Select 'copia i movimenti di 15 giorni prima per lasciarti una copia in caso servisse
      Range("pp1:qc2489").Select
      Selection.Copy
      Range("qf1").Select
      ActiveSheet.Paste
      
      Sheets("stampa movimenti").Select 'copia i movimenti di 15 giorni prima per lasciarti una copia in caso servisse
      Range("oz1:pm2489").Select
      Selection.Copy
      Range("pp1").Select
      ActiveSheet.Paste
      
      Sheets("stampa movimenti").Select 'copia i movimenti di 15 giorni prima per lasciarti una copia in caso servisse
      Range("oj1:ow2489").Select
      Selection.Copy
      Range("oz1").Select
      ActiveSheet.Paste
      
      Sheets("stampa movimenti").Select 'copia i movimenti di 25 giorni prima per lasciarti una copia in caso servisse
      Range("nt1:og2489").Select
      Selection.Copy
      Range("oj1").Select
      ActiveSheet.Paste
      
      Sheets("stampa movimenti").Select 'copia i movimenti di 24 giorni prima per lasciarti una copia in caso servisse
      Range("nd1:nq2489").Select
      Selection.Copy
      Range("nt1").Select
      ActiveSheet.Paste
      
      Sheets("stampa movimenti").Select 'copia i movimenti di 23 giorni prima per lasciarti una copia in caso servisse
      Range("mn1:na2489").Select
      Selection.Copy
      Range("nd1").Select
      ActiveSheet.Paste
      
      Sheets("stampa movimenti").Select 'copia i movimenti di 22 giorni prima per lasciarti una copia in caso servisse
      Range("lb1:mk2489").Select
      Selection.Copy
      Range("mn1").Select
      ActiveSheet.Paste
      
      Sheets("stampa movimenti").Select 'copia i movimenti di 21 giorni prima per lasciarti una copia in caso servisse
      Range("ll1:ly2489").Select
      Selection.Copy
      Range("lb1").Select
      ActiveSheet.Paste
      
      Sheets("stampa movimenti").Select 'copia i movimenti di 20 giorni prima per lasciarti una copia in caso servisse
      Range("kv1:li2489").Select
      Selection.Copy
      Range("ll1").Select
      ActiveSheet.Paste
      
      Sheets("stampa movimenti").Select 'copia i movimenti di 19 giorni prima per lasciarti una copia in caso servisse
      Range("kf1:ks2489").Select
      Selection.Copy
      Range("kv1").Select
      
      ActiveSheet.Paste
      Sheets("stampa movimenti").Select 'copia i movimenti di 18 giorni prima per lasciarti una copia in caso servisse
      Range("jo1:kc2489").Select
      Selection.Copy
      Range("kf1").Select
      ActiveSheet.Paste
      
      Sheets("stampa movimenti").Select 'copia i movimenti di 17 giorni prima per lasciarti una copia in caso servisse
      Range("iy1:jl2489").Select
      Selection.Copy
      Range("jo1").Select
      ActiveSheet.Paste
      
      Sheets("stampa movimenti").Select 'copia i movimenti di 16 giorni prima per lasciarti una copia in caso servisse
      Range("ii1:iv2489").Select
      Selection.Copy
      Range("iy1").Select
      ActiveSheet.Paste
      
      Sheets("stampa movimenti").Select 'copia i movimenti di 15 giorni prima per lasciarti una copia in caso servisse
      Range("hs1:if2489").Select
      Selection.Copy
      Range("ii1").Select
      ActiveSheet.Paste
      
      Sheets("stampa movimenti").Select 'copia i movimenti di 14 giorni prima per lasciarti una copia in caso servisse
      Range("hc1:hp2489").Select
      Selection.Copy
      Range("hs1").Select
      ActiveSheet.Paste
      
      Sheets("stampa movimenti").Select 'copia i movimenti di 13 giorni prima per lasciarti una copia in caso servisse
      Range("gm1:gz2489").Select
      Selection.Copy
      Range("hc1").Select
      ActiveSheet.Paste
      
      Sheets("stampa movimenti").Select 'copia i movimenti di 12 giorni prima per lasciarti una copia in caso servisse
      Range("fw1:gj2489").Select
      Selection.Copy
      Range("gm1").Select
      ActiveSheet.Paste
      
      Sheets("stampa movimenti").Select 'copia i movimenti di 11 giorni prima per lasciarti una copia in caso servisse
      Range("fg1:ft2489").Select
      Selection.Copy
      Range("fw1").Select
      ActiveSheet.Paste
      
      Sheets("stampa movimenti").Select 'copia i movimenti di 10 giorni prima per lasciarti una copia in caso servisse
      Range("eq1:fd2489").Select
      Selection.Copy
      Range("fg1").Select
      ActiveSheet.Paste
      
      Sheets("stampa movimenti").Select 'copia i movimenti di 9 giorni prima per lasciarti una copia in caso servisse
      Range("ea1:en2489").Select
      Selection.Copy
      Range("eq1").Select
      ActiveSheet.Paste
      
      Sheets("stampa movimenti").Select 'copia i movimenti di 8 giorni prima per lasciarti una copia in caso servisse
      Range("dk1:dx2489").Select
      Selection.Copy
      Range("ea1").Select
      ActiveSheet.Paste
      
      Sheets("stampa movimenti").Select 'copia i movimenti di 7 giorni prima per lasciarti una copia in caso servisse
      Range("cu1:dh2489").Select
      Selection.Copy
      Range("dk1").Select
      ActiveSheet.Paste
      
      Sheets("stampa movimenti").Select 'copia i movimenti di 6 giorni prima per lasciarti una copia in caso servisse
      Range("ce1:cr2489").Select
      Selection.Copy
      Range("cu1").Select
      ActiveSheet.Paste
      
      Sheets("stampa movimenti").Select 'copia i movimenti di 5 giorni prima per lasciarti una copia in caso servisse
      Range("bo1:cb2489").Select
      Selection.Copy
      Range("ce1").Select
      ActiveSheet.Paste
      
      Sheets("stampa movimenti").Select 'copia i movimenti di 4 giorni prima per lasciarti una copia in caso servisse
      Range("ay1:bl2489").Select
      Selection.Copy
      Range("bo1").Select
      ActiveSheet.Paste
      
      Sheets("stampa movimenti").Select 'copia i movimenti di 3 giorni prima per lasciarti una copia in caso servisse
      Range("ai1:av2489").Select
      Selection.Copy
      Range("ay1").Select
      ActiveSheet.Paste
      
      Sheets("stampa movimenti").Select 'copia i movimenti di 2 giorni prima per lasciarti una copia in caso servisse
      Range("s1:af2489").Select
      Selection.Copy
      Range("ai1").Select
      ActiveSheet.Paste
      
      Sheets("stampa movimenti").Select 'copia i movimenti del giorno prima per lasciarti una copia in caso servisse
      Range("A1:N2489").Select
      Selection.Copy
      Range("S1").Select
      ActiveSheet.Paste

      codice completo

      Option Explicit
      Public sh1 As Worksheet, sh2 As Worksheet, x As Long, y As Long, z As Long, cfound As Range
      
      Sub avvia()
      Dim ws1 As Worksheet 'copia gli usciti dal foglio "stampa movimenti" al foglio "usciti"
      Dim ws2 As Worksheet
      Dim ultK As Long
      Dim ultA As Long
      Dim iRiga As Long
      
      Sheets("ubic ieri").Select ' copia le ubicazioni di ieri dal foglio archivio al foglio ubic ieri così in caso di ubicazione con ?? puoi chiamare il reparto e chiedere dov'è andato
      Columns("A:D").Select
      Range("A2").Activate
      Selection.Copy
      Columns("F:F").Select
      Range("F2").Activate
      ActiveSheet.Paste
      Application.DisplayAlerts = False
      Sheets("archivio").Select
      Range("A3:D2489").Select
      Range("A3").Activate
      Selection.Copy
      Sheets("ubic ieri").Select
      Range("A2").Select
      ActiveSheet.Paste
      Application.CutCopyMode = False
      Application.DisplayAlerts = True
      
      Set ws1 = Foglio11 'fa riferimentoal foglio "stampa movimenti" che si trova all'11esimo posto nel file che vedi ma nel progetto-vbaproject
      Set ws2 = Foglio21 'fa riferimento al foglio "usciti" che si trova al 21esimo posto nel file che vedi ma nel progetto-vbaproject
      ultK = IIf(ws1.Range("K3").Value = "", 3, ws1.Range("K" & Rows.Count).End(xlUp).Row)
      ultA = IIf(ws2.Range("A60000").Value = "", 60000, ws2.Range("A" & Rows.Count).End(xlUp).Row + 1)
      Application.EnableEvents = False
      If ultK > 2 Then
      For iRiga = 3 To ultK
      ws2.Range("A" & ultA).Value = ws1.Range("K" & iRiga).Value & " " & ws1.Range("L" & iRiga).Value
      ws2.Range("B" & ultA).Value = Date 'inserisce la data del giorno che copia il nominatico e quindi la data di uscita del detenuto
      ultA = ultA + 1
      Next iRiga
      End If
      Set ws1 = Nothing
      Set ws2 = Nothing
      
      Sheets("usciti").Select 'ordina alfabetico la colonna "A" del foglio usciti
      Columns("A:B").Select
      Selection.Sort Key1:=Range("A1"), Order1:=xlAscending, Header:=xlGuess, _
      OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
      DataOption1:=xlSortNormal
      
      Application.DisplayAlerts = False 'questa riga insieme ad Application.DisplayAlerts = true che si trova alla fine del codice dei copia movimenti, serve a far si che i nomi vecchi vengano cancellati e sostituiti da quelli nuovi senza che esca la finestra che ti chiede sostituirli o no.
      
      Sheets("stampa movimenti").Select 'copia i movimenti di 15 giorni prima per lasciarti una copia in caso servisse
      Range("sr1:if2489").Select
      Selection.Copy
      Range("ii1").Select
      ActiveSheet.Paste
      
      Sheets("stampa movimenti").Select 'copia i movimenti di 15 giorni prima per lasciarti una copia in caso servisse
      Range("sb1:so2489").Select
      Selection.Copy
      Range("sr1").Select
      ActiveSheet.Paste
      
      Sheets("stampa movimenti").Select 'copia i movimenti di 15 giorni prima per lasciarti una copia in caso servisse
      Range("rl1:ry2489").Select
      Selection.Copy
      Range("sb1").Select
      ActiveSheet.Paste
      
      Sheets("stampa movimenti").Select 'copia i movimenti di 15 giorni prima per lasciarti una copia in caso servisse
      Range("qv1:ri2489").Select
      Selection.Copy
      Range("rl1").Select
      ActiveSheet.Paste
      
      Sheets("stampa movimenti").Select 'copia i movimenti di 15 giorni prima per lasciarti una copia in caso servisse
      Range("qf1:qs2489").Select
      Selection.Copy
      Range("qv1").Select
      ActiveSheet.Paste
      
      Sheets("stampa movimenti").Select 'copia i movimenti di 15 giorni prima per lasciarti una copia in caso servisse
      Range("pp1:qc2489").Select
      Selection.Copy
      Range("qf1").Select
      ActiveSheet.Paste
      
      Sheets("stampa movimenti").Select 'copia i movimenti di 15 giorni prima per lasciarti una copia in caso servisse
      Range("oz1:pm2489").Select
      Selection.Copy
      Range("pp1").Select
      ActiveSheet.Paste
      
      Sheets("stampa movimenti").Select 'copia i movimenti di 15 giorni prima per lasciarti una copia in caso servisse
      Range("oj1:ow2489").Select
      Selection.Copy
      Range("oz1").Select
      ActiveSheet.Paste
      
      Sheets("stampa movimenti").Select 'copia i movimenti di 15 giorni prima per lasciarti una copia in caso servisse
      Range("nt1:og2489").Select
      Selection.Copy
      Range("oj1").Select
      ActiveSheet.Paste
      
      Sheets("stampa movimenti").Select 'copia i movimenti di 15 giorni prima per lasciarti una copia in caso servisse
      Range("nd1:nq2489").Select
      Selection.Copy
      Range("nt1").Select
      ActiveSheet.Paste
      
      Sheets("stampa movimenti").Select 'copia i movimenti di 15 giorni prima per lasciarti una copia in caso servisse
      Range("mn1:na2489").Select
      Selection.Copy
      Range("nd1").Select
      ActiveSheet.Paste
      
      Sheets("stampa movimenti").Select 'copia i movimenti di 15 giorni prima per lasciarti una copia in caso servisse
      Range("lb1:mk2489").Select
      Selection.Copy
      Range("mn1").Select
      ActiveSheet.Paste
      
      Sheets("stampa movimenti").Select 'copia i movimenti di 15 giorni prima per lasciarti una copia in caso servisse
      Range("ll1:ly2489").Select
      Selection.Copy
      Range("lb1").Select
      ActiveSheet.Paste
      
      Sheets("stampa movimenti").Select 'copia i movimenti di 15 giorni prima per lasciarti una copia in caso servisse
      Range("kv1:li2489").Select
      Selection.Copy
      Range("ll1").Select
      ActiveSheet.Paste
      
      Sheets("stampa movimenti").Select 'copia i movimenti di 15 giorni prima per lasciarti una copia in caso servisse
      Range("kf1:ks2489").Select
      Selection.Copy
      Range("kv1").Select
      
      ActiveSheet.Paste
      Sheets("stampa movimenti").Select 'copia i movimenti di 15 giorni prima per lasciarti una copia in caso servisse
      Range("jo1:kc2489").Select
      Selection.Copy
      Range("kf1").Select
      ActiveSheet.Paste
      
      Sheets("stampa movimenti").Select 'copia i movimenti di 15 giorni prima per lasciarti una copia in caso servisse
      Range("iy1:jl2489").Select
      Selection.Copy
      Range("jo1").Select
      ActiveSheet.Paste
      
      Sheets("stampa movimenti").Select 'copia i movimenti di 15 giorni prima per lasciarti una copia in caso servisse
      Range("ii1:iv2489").Select
      Selection.Copy
      Range("iy1").Select
      ActiveSheet.Paste
      
      Sheets("stampa movimenti").Select 'copia i movimenti di 15 giorni prima per lasciarti una copia in caso servisse
      Range("hs1:if2489").Select
      Selection.Copy
      Range("ii1").Select
      ActiveSheet.Paste
      
      Sheets("stampa movimenti").Select 'copia i movimenti di 14 giorni prima per lasciarti una copia in caso servisse
      Range("hc1:hp2489").Select
      Selection.Copy
      Range("hs1").Select
      ActiveSheet.Paste
      
      Sheets("stampa movimenti").Select 'copia i movimenti di 13 giorni prima per lasciarti una copia in caso servisse
      Range("gm1:gz2489").Select
      Selection.Copy
      Range("hc1").Select
      ActiveSheet.Paste
      
      Sheets("stampa movimenti").Select 'copia i movimenti di 12 giorni prima per lasciarti una copia in caso servisse
      Range("fw1:gj2489").Select
      Selection.Copy
      Range("gm1").Select
      ActiveSheet.Paste
      
      Sheets("stampa movimenti").Select 'copia i movimenti di 11 giorni prima per lasciarti una copia in caso servisse
      Range("fg1:ft2489").Select
      Selection.Copy
      Range("fw1").Select
      ActiveSheet.Paste
      
      Sheets("stampa movimenti").Select 'copia i movimenti di 10 giorni prima per lasciarti una copia in caso servisse
      Range("eq1:fd2489").Select
      Selection.Copy
      Range("fg1").Select
      ActiveSheet.Paste
      
      Sheets("stampa movimenti").Select 'copia i movimenti di 9 giorni prima per lasciarti una copia in caso servisse
      Range("ea1:en2489").Select
      Selection.Copy
      Range("eq1").Select
      ActiveSheet.Paste
      
      Sheets("stampa movimenti").Select 'copia i movimenti di 8 giorni prima per lasciarti una copia in caso servisse
      Range("dk1:dx2489").Select
      Selection.Copy
      Range("ea1").Select
      ActiveSheet.Paste
      
      Sheets("stampa movimenti").Select 'copia i movimenti di 7 giorni prima per lasciarti una copia in caso servisse
      Range("cu1:dh2489").Select
      Selection.Copy
      Range("dk1").Select
      ActiveSheet.Paste
      
      Sheets("stampa movimenti").Select 'copia i movimenti di 6 giorni prima per lasciarti una copia in caso servisse
      Range("ce1:cr2489").Select
      Selection.Copy
      Range("cu1").Select
      ActiveSheet.Paste
      
      Sheets("stampa movimenti").Select 'copia i movimenti di 5 giorni prima per lasciarti una copia in caso servisse
      Range("bo1:cb2489").Select
      Selection.Copy
      Range("ce1").Select
      ActiveSheet.Paste
      
      Sheets("stampa movimenti").Select 'copia i movimenti di 4 giorni prima per lasciarti una copia in caso servisse
      Range("ay1:bl2489").Select
      Selection.Copy
      Range("bo1").Select
      ActiveSheet.Paste
      
      Sheets("stampa movimenti").Select 'copia i movimenti di 3 giorni prima per lasciarti una copia in caso servisse
      Range("ai1:av2489").Select
      Selection.Copy
      Range("ay1").Select
      ActiveSheet.Paste
      
      Sheets("stampa movimenti").Select 'copia i movimenti di 2 giorni prima per lasciarti una copia in caso servisse
      Range("s1:af2489").Select
      Selection.Copy
      Range("ai1").Select
      ActiveSheet.Paste
      
      Sheets("stampa movimenti").Select 'copia i movimenti del giorno prima per lasciarti una copia in caso servisse
      Range("A1:N2489").Select
      Selection.Copy
      Range("S1").Select
      ActiveSheet.Paste
      
      Application.DisplayAlerts = True 'questa riga insieme ad Application.DisplayAlerts = False che si trova all'inizio del codice dei copia movimenti, serve a far si che i nomi vecchi vengano cancellati e sostituiti da quelli nuovi senza che esca la finestra che ti chiede sostituirli o no.
      
      Sheets("data nascita").Select ' AGGIORNA IL FOGLIO DATA DI NASCITA PRIMA IL MASCHILE E POI IL FEMMINILE CON IL GEDET
      Range("A1").Select
      Selection.QueryTable.Refresh BackgroundQuery:=False
      Range("f1").Select
      Selection.QueryTable.Refresh BackgroundQuery:=False
      
      Sheets("presenti").Select 'aggiorna i dati del foglio "presenti" con il file gedet che si trova sul gedet
      Dim iki As Long
      For iki = 1 To 224 Step 7 'iki è il un riferimento che si da alla colonna quindi si inizia ad aggiornare dalla colonna 1perch' iki=1 e si arriva alla 129 saltando di 7 colonne step=7
      Cells(2, iki).Select 'iniziando dalla riga 2 colonna 1
      Selection.QueryTable.Refresh BackgroundQuery:=False
      Next iki
      
      Sheets("I").Select ' seleziona A5-B5-C5 di tutte le sezioni e trascina giu per eliminare errori
      Range("A5:C5").Select
      Selection.AutoFill Destination:=Range("A5:C92"), Type:=xlFillDefault
      Range("A5:C92").Select
      Sheets("II").Select
      Range("A5:C5").Select
      Selection.AutoFill Destination:=Range("A5:C92"), Type:=xlFillDefault
      Range("A5:C92").Select
      Sheets("III").Select
      Range("A5:C5").Select
      Selection.AutoFill Destination:=Range("A5:C92"), Type:=xlFillDefault
      Range("A5:C92").Select
      Sheets("IV").Select
      Range("A5:C5").Select
      Selection.AutoFill Destination:=Range("A5:C92"), Type:=xlFillDefault
      Range("A5:C92").Select
      Sheets("V").Select
      Range("A5:C5").Select
      Selection.AutoFill Destination:=Range("A5:C92"), Type:=xlFillDefault
      Range("A5:C92").Select
      Sheets("VI").Select
      Range("A5:C5").Select
      Selection.AutoFill Destination:=Range("A5:C92"), Type:=xlFillDefault
      Range("A5:C92").Select
      Sheets("VII").Select
      Range("A5:C5").Select
      Selection.AutoFill Destination:=Range("A5:C92"), Type:=xlFillDefault
      Range("A5:C92").Select
      Sheets("VIII").Select
      Range("A5:C5").Select
      Selection.AutoFill Destination:=Range("A5:C92"), Type:=xlFillDefault
      Range("A5:C92").Select
      Sheets("IX").Select
      Range("A5:C5").Select
      Selection.AutoFill Destination:=Range("A5:C89"), Type:=xlFillDefault
      Range("A5:C89").Select
      Sheets("X").Select
      Range("A5:C5").Select
      Selection.AutoFill Destination:=Range("A5:C90"), Type:=xlFillDefault
      Range("A5:C90").Select
      Sheets("XI").Select
      Range("A5:C5").Select
      Selection.AutoFill Destination:=Range("A5:C89"), Type:=xlFillDefault
      Range("A5:C89").Select
      Sheets("XII").Select
      Range("A5:C5").Select
      Selection.AutoFill Destination:=Range("A5:C89"), Type:=xlFillDefault
      Range("A5:C89").Select
      Sheets("XIII").Select
      Range("A5:C5").Select
      Selection.AutoFill Destination:=Range("A5:C89"), Type:=xlFillDefault
      Range("A5:C89").Select
      
      Sheets("C.CL.").Select
      Range("A5:C5").Select
      Selection.AutoFill Destination:=Range("A5:C50"), Type:=xlFillDefault
      Range("A5:C50").Select
      Range("A51:C51").Select
      Selection.AutoFill Destination:=Range("A51:C70"), Type:=xlFillDefault
      Range("A51:C70").Select
      Range("A71:C71").Select
      Selection.AutoFill Destination:=Range("A71:C120"), Type:=xlFillDefault
      Range("A71:C120").Select
      Range("A121:C121").Select
      Selection.AutoFill Destination:=Range("A121:C140"), Type:=xlFillDefault
      Range("A121:C140").Select
      Range("A141:C141").Select
      Selection.AutoFill Destination:=Range("A141:C150"), Type:=xlFillDefault
      Range("A141:C150").Select
      Range("A151:C151").Select
      Selection.AutoFill Destination:=Range("A151:C170"), Type:=xlFillDefault
      Range("A151:C170").Select
      Range("A171:C171").Select
      Selection.AutoFill Destination:=Range("A171:C210"), Type:=xlFillDefault
      Range("A171:C210").Select
      Range("A211:C211").Select
      Selection.AutoFill Destination:=Range("A211:C240"), Type:=xlFillDefault
      Range("A211:C240").Select
      Range("A345:C345").Select
      Selection.AutoFill Destination:=Range("A345:C466"), Type:=xlFillDefault
      Range("A345:C466").Select
      Range("A347:C347").Select
      Selection.AutoFill Destination:=Range("A347:C497"), Type:=xlFillDefault
      Range("A347:C497").Select
      Range("A498:C498").Select
      Selection.AutoFill Destination:=Range("A498:C599"), Type:=xlFillDefault
      Range("A498:C599").Select
      Range("A600:C600").Select
      Selection.AutoFill Destination:=Range("A600:C699"), Type:=xlFillDefault
      Range("A600:C699").Select
      Range("A700:C700").Select
      Selection.AutoFill Destination:=Range("A700:C739"), Type:=xlFillDefault
      Range("A700:C739").Select
      Range("A740:C740").Select
      Selection.AutoFill Destination:=Range("A740:C749"), Type:=xlFillDefault
      Range("A740:C749").Select
      Range("A750:C750").Select
      Selection.AutoFill Destination:=Range("A750:C769"), Type:=xlFillDefault
      Range("A750:C769").Select
      Range("A770:C770").Select
      Selection.AutoFill Destination:=Range("A770:C800"), Type:=xlFillDefault
      Range("A770:C800").Select
      Range("a801:C801").Select
      Selection.AutoFill Destination:=Range("A801:C810"), Type:=xlFillDefault
      Range("A801:C810").Select
      Range("a811:C811").Select
      Selection.AutoFill Destination:=Range("A811:C830"), Type:=xlFillDefault
      Range("A811:C830").Select
      Range("a831:C831").Select
      Selection.AutoFill Destination:=Range("A831:C850"), Type:=xlFillDefault
      Range("A831:C850").Select
      
      Sheets("Transex").Select
      Range("A5:C5").Select
      Selection.AutoFill Destination:=Range("A5:C32"), Type:=xlFillDefault
      Range("A5:C32").Select
      Sheets("TR1").Select
      Range("A5:C5").Select
      Selection.AutoFill Destination:=Range("A5:C61"), Type:=xlFillDefault
      Range("A5:C61").Select
      Sheets("TR2").Select
      Range("A5:D5").Select
      Selection.AutoFill Destination:=Range("A5:D34"), Type:=xlFillDefault
      Range("A5:D34").Select
      
      Dim r As Long 'controlla i cambiamenti tra foglio"archivio" e tutti i fogli delle sezioni
      Dim rr As Long
      Dim G As Long
      Dim K As Long
      Dim l As Variant
      Dim n As String
      Dim p As Variant
      Dim nn As Variant
      Dim rg As Long
      Dim trovato As Boolean
      Dim dat(1 To 3)
      Set sh1 = Worksheets("Archivio")
      sh1.Activate
      Application.EnableEvents = False
      rg = Cells(Rows.Count, 15).End(xlUp).Row + 1
      Range(Cells(3, 5), Cells(rg, 6)).ClearContents
      Range(Cells(3, 15), Cells(rg, 15)).ClearContents
      G = Cells(Rows.Count, 7).End(xlUp).Row + 1
      Range(Cells(3, 7), Cells(G, 10)).ClearContents
      K = Cells(Rows.Count, 11).End(xlUp).Row + 1
      Range(Cells(3, 11), Cells(K, 14)).ClearContents
      'Application.ScreenUpdating = False''non fa vedere i passaggi dei controlli sezione per sezione se togli le virgolette lo attivi'
      G = 3
      K = 3
      For x = 1 To 18
      Sheets(x).Select
      rg = Cells(Rows.Count, 1).End(xlUp).Row
      n = Sheets(x).Name
      Set sh2 = Worksheets(n)
      Select Case n
      Case "I": p = 1 'assegna alla sezione il numero normale anzichè il numero romano'
      Case "II": p = 2
      Case "III": p = 3
      Case "IV": p = 4
      Case "V": p = 5
      Case "VI": p = 6
      Case "VII": p = 7
      Case "VIII": p = 8
      Case "IX": p = 9
      Case "X": p = 10
      Case "XI": p = 11
      Case "XII": p = 12
      Case "XIII": p = 13
      Case "Transex": p = "D"
      Case "TR1": p = "TR1"
      Case "TR2": p = "TR2"
      Case "FEMMINILE": p = "F"
      End Select
      For y = 5 To rg
      If Cells(y, 2) = "" Or Cells(y, 2) = 0 Then
      GoTo 10
      Else
      If Cells(y, 1) <> "" Then
      If n = "C.CL." Then 'nel foglio centro clinico...'
      Select Case y
      Case 5 To 140: p = "ccl" 'le celle da 5 a 50 è reparto DEG'
      'Case 51 To 70: p = "OSS."
      'Case 71 To 140: p = "acc."
      Case 141 To 150: p = "M"
      Case 151 To 170: p = "FXG"
      Case 171 To 210: p = "PER"
      Case 211 To 240: p = "R.O."
      Case 241 To 290: p = "nota"
      Case 291 To 344: p = "ITO"
      Case 345 To 497: p = "?"
      Case 498 To 599: p = "GIU"
      Case 600 To 699: p = "PEN"
      Case 700 To 739: p = "CCC"
      Case 740 To 749: p = "K"
      Case 750 To 769: p = "TRF"
      Case 770 To 800: p = "NIDO"
      Case 801 To 810: p = "FXGF"
      Case 811 To 830: p = "PF"
      Case 831 To 850: p = "ROF"
      End Select
      End If
      If IsNumeric(Cells(y, 1)) Then l = Val(Cells(y, 1)) Else l = Cells(y, 1)
      End If
      dat(1) = l
      dat(2) = Cells(y, 2)
      dat(3) = Cells(y, 3)
      End If
      rr = sh1.Cells(Rows.Count, 1).End(xlUp).Row
      For z = 2 To rr
      If sh1.Cells(z, 1) = dat(2) And sh1.Cells(z, 2) = dat(3) Then trovato = True: r = z: Exit For
      Next z
      If trovato = True Then
      If sh1.Cells(r, 3) = p And sh1.Cells(r, 4) = dat(1) Then
      sh1.Cells(r, 15) = 1
      Else
      sh1.Cells(r, 5) = p
      sh1.Cells(r, 6) = dat(1)
      sh1.Cells(r, 15) = 1
      End If
      End If
      If trovato = False Then
      r = rr + 1
      sh1.Cells(r, 1) = dat(2)
      sh1.Cells(r, 2) = dat(3)
      sh1.Cells(r, 3) = p
      sh1.Cells(r, 4) = dat(1)
      sh1.Cells(G, 7) = dat(2)
      sh1.Cells(G, 8) = dat(3)
      sh1.Cells(G, 9) = p
      sh1.Cells(G, 10) = dat(1)
      sh1.Cells(r, 15) = 0
      G = G + 1
      End If
      trovato = False
      10:
      Next y
      Next x
      sh1.Activate
      r = Cells(Rows.Count, 15).End(xlUp).Row
      For x = 3 To r
      If x = r Then Exit For
      If Cells(x, 15) = "" Then
      Cells(K, 11) = Cells(x, 1)
      Cells(K, 12) = Cells(x, 2)
      Cells(K, 13) = Cells(x, 3)
      Cells(K, 14) = Cells(x, 4)
      Range(Cells(x, 1), Cells(x, 6)).Select
      Selection.Delete Shift:=xlUp
      Cells(x, 15).Select
      Selection.Delete Shift:=xlUp
      x = x - 1
      r = r - 1
      K = K + 1
      End If
      Next x
      Range("A2:F2").Select
      Range(Selection, Selection.End(xlDown)).Select
      Selection.Sort Key1:=Range("E3"), Order1:=xlAscending, Key2:=Range("A3") _
      , Order2:=xlAscending, Header:=xlGuess, OrderCustom:=1, MatchCase:= _
      False, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal, DataOption2 _
      :=xlSortNormal
      r = Cells(Rows.Count, 5).End(xlUp).Row
      Range("A2:F" & r).Select ' ordia alfabetico i movimenti'
      Selection.Sort Key1:=Range("A3"), Order1:=xlAscending, Header:=xlYes, _
      OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
      DataOption1:=xlSortNormal
      Range("G2:J2").Select 'ordina alfabetico gli entrati'
      Range(Selection, Selection.End(xlDown)).Select
      Selection.Sort Key1:=Range("G3"), Order1:=xlAscending, Header:=xlYes, _
      OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
      DataOption1:=xlSortNormal
      Range("k2:N2").Select 'ordina alfabetico gli usciti'
      Range(Selection, Selection.End(xlDown)).Select
      Selection.Sort Key1:=Range("K3"), Order1:=xlAscending, Header:=xlYes, _
      OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
      DataOption1:=xlSortNormal
      Range("A3").Select
      Application.EnableEvents = True
      Application.ScreenUpdating = True
      Sheets("archivio").Select
      
      Application.DisplayAlerts = False ' copia i nominativi dal foglio archivio al fogli stampa i moviment
      Sheets("archivio").Select
      Range("A1:r400").Select
      Application.CutCopyMode = False
      Selection.Copy
      Sheets("stampa movimenti").Select
      Range("A1:B1").Select
      ActiveSheet.Paste
      Application.DisplayAlerts = True
      Range("A1:R972").Select
      Application.CutCopyMode = False
      Selection.Interior.ColorIndex = xlNone
      
      'Sub sta1()
      Dim rt As Long
      Dim r1 As Long
      Dim st As String
      Dim cp As Long
      Dim d As Long
      Dim ind As Variant
      Dim rrt As Long
      Dim rrtt As Long
      Dim rrttt As Long
      Dim rrrt As Long
      'ELIMINA GLI ENTRATI E GLI USCITI CHE VENGONO RINOMINATI PERCHE' IL NOME SBAGLIATO E FINISCE A FINE 7
      Dim Gt As Range, KK As Range, cl3 As Object, cl4 As Object, _
      xx As Long, yy As Long, zt As Long, xt As Long, _
      yt As Long, zz As Long, xtt As Long, xttt As Long, xXtt As Long
      Set Gt = Range("G3:G1500")
      Set KK = Range("K3:K1500")
      'mmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmm
      'AMMETTENDO CHE LA RIGA 1 è OCCUPATA DALLE INTESTAZIONI DI COLONNA
      'EFFETTUO UN CICLO PER TROVARE LA PRIMA CELLA OCCUPATA DELLA COLONNA G;
      'IN OGNI CASO PUOI MODIFICARE IL RANGE G e K EDITANDO LE VARIABILI SOPRA (Set)
      For Each cl3 In Gt
      If cl3 = "" Then
      cl3.Select
      xt = Selection.Row
      Exit For
      'If cl3 <> "" Then
      Else
      cl3.Select
      xt = Selection.Row
      'xt è IL NUMERO RIGA DELLA PRIMA CELLA OCCUPATA DELLA COLONNA G
      Exit For
      End If
      Next
      If cl3 = "" Then
      yt = Cells(1500, 7).End(xlUp).Row + 1
      Else
      yt = Cells(1500, 7).End(xlUp).Row
      End If
      'yt è IL NUMERO RIGA DELL'ULTIMA CELLA OCCUPATA DELLA COLONNA G
      'mmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmm
      'EFFETTUO UN CICLO PER TROVARE LA PRIMA CELLA OCCUPATA DELLA COLONNA K
      For Each cl4 In KK
      If cl4 = "" Then
      cl4.Select
      xx = Selection.Row
      Exit For
      'If cl4 <> "" Then
      Else
      cl4.Select
      xx = Selection.Row
      'xx è IL NUMERO RIGA DELLA PRIMA CELLA OCCUPATA DELLA COLONNA K
      Exit For
      End If
      Next
      If cl4 = "" Then
      yy = Cells(1500, 11).End(xlUp).Row + 1
      Else
      yy = Cells(1500, 11).End(xlUp).Row
      End If
      'yy è IL NUMERO RIGA DELL'ULTIMA CELLA OCCUPATA DELLA COLONNA K
      'mmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmm
      'DOPPIO CICLO FOR/NEXT PER CONTROLLARE OGNI RIGA OCCUPATA DELLE
      'COLONNE G-H-I-J CON OGNI RIGA OCCUPATA DELLE COLONNE K-L-M-N
      For zt = xt To yt
      For zz = xx To yy
      If Cells(zt, 9) = Cells(zz, 13) And Cells(zt, 10) = Cells(zz, 14) _
      And (Cells(zt, 7) = Cells(zz, 11) Or Cells(zt, 8) = Cells(zz, 12)) Then
      Range(Cells(zt, 7), Cells(zt, 10)).ClearContents
      Range(Cells(zz, 11), Cells(zz, 14)).ClearContents
      End If
      Next zz
      Next zt
      'FINE 7
      
      Dim cl, cl2, rng, RNG2, NOME, COGNOME ' CANCELLA I CAMBIAMENTI DI CELLA DEL CCL TR1 TR2 F D IL CODICE FINISCE DOV'è SCRITTO FINE2
      rt = Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
      Dim Condizioni As New Collection
      Condizioni.Add "F|F"
      Condizioni.Add "K|K"
      Condizioni.Add "K|NIDO"
      Condizioni.Add "K|PEN"
      Condizioni.Add "K|GIU"
      Condizioni.Add "K|CCC"
      Condizioni.Add "NIDO|NIDO"
      Condizioni.Add "NIDO|PEN"
      Condizioni.Add "NIDO|GIU"
      Condizioni.Add "NIDO|K"
      Condizioni.Add "NIDO|CCC"
      Condizioni.Add "PEN|PEN"
      Condizioni.Add "PEN|K"
      Condizioni.Add "PEN|NIDO"
      Condizioni.Add "PEN|GIU"
      Condizioni.Add "PEN|CCC"
      Condizioni.Add "GIU|GIU"
      Condizioni.Add "GIU|K"
      Condizioni.Add "GIU|NIDO"
      Condizioni.Add "GIU|PEN"
      Condizioni.Add "GIU|CCC"
      Condizioni.Add "CCC|CCC"
      Condizioni.Add "CCC|K"
      Condizioni.Add "CCC|NIDO"
      Condizioni.Add "CCC|PEN"
      Condizioni.Add "CCC|GIU"
      Condizioni.Add "D|D"
      Condizioni.Add "TR1|TR1"
      Condizioni.Add "TR2|TR2"
      'Condizioni.Add "TR2|TR1"
      'Condizioni.Add "TR1|TR2"
      Condizioni.Add "OSS.|OSS."
      Condizioni.Add "I.S.|I.S."
      Condizioni.Add "EXD.|EXD."
      Condizioni.Add "DEG.|DEG."
      Condizioni.Add "DEG.|OSS."
      Condizioni.Add "DEG.|EXD."
      Condizioni.Add "DEG.|I.S."
      Condizioni.Add "OSS.|EXD."
      Condizioni.Add "OSS.|I.S."
      Condizioni.Add "OSS.|DEG."
      Condizioni.Add "EXD.|DEG."
      Condizioni.Add "EXD.|OSS."
      Condizioni.Add "EXD.|I.S."
      Condizioni.Add "I.S.|EXD."
      Condizioni.Add "I.S.|OSS."
      Condizioni.Add "I.S.|DEG."
      ReDim c(rt) As Integer
      Dim i, j, Kt, cond
      Set RNG2 = Range("C3:E" & rt)
      For Each cl2 In RNG2
      For Each cond In Condizioni
      If cl2.Offset(0, 0) = Split(cond, "|")(0) And cl2.Offset(0, 2) = Split(cond, "|")(1) Then
      i = i + 1
      c(i) = cl2.Row
      End If
      Next
      Next
      Kt = i
      Sheets("stampa movimenti").Select
      For i = 1 To Kt
      ActiveSheet.Range("A1:F1").Offset(c(i) - 1, 0).Delete
      For j = i + 1 To Kt
      c(j) = c(j) - 1
      Next
      Next 'FINE2
      
      rrt = Range("I" & Rows.Count).End(xlUp).Row 'cancella nella colonna entrati il femminile tr1 e tr2 il codice finisce a fine 6
      For xt = 3 To rrt
      If Cells(xt, "I") = "F" Or Cells(xt, "I") = "FXG" Or Cells(xt, "I") = "FXGF" Or Cells(xt, "I") = "TR1" Or Cells(xt, "I") = "TR2" Or Cells(xt, "I") = "GIU" Or Cells(xt, "I") = "PEN" Or Cells(xt, "I") = "CCC" Or Cells(xt, "I") = "NIDO" Or Cells(xt, "I") = "K" Or Cells(xt, "I") = "?" Then
      Range("G" & xt & ":" & "J" & xt).ClearContents
      End If
      Next xt 'fine 5
      
      rrtt = Range("E" & Rows.Count).End(xlUp).Row 'cancella nella colonna movimenti i fuori per giustizia i detenuti da prendere in carico(?)i permessi e ricovero finisce a fine 6
      For xtt = 3 To rrtt
      If Cells(xtt, "E") = "PER" Or Cells(xtt, "E") = "FXG" Or Cells(xtt, "I") = "FXGF" Or Cells(xtt, "E") = "R.O." Or Cells(xtt, "E") = "GIU" Or Cells(xtt, "E") = "PEN" Or Cells(xtt, "E") = "CCC" Or Cells(xtt, "E") = "NIDO" Or Cells(xtt, "E") = "K" Then
      Range("A" & xtt & ":" & "F" & xtt).ClearContents
      End If
      Next xtt
      rrttt = Range("C" & Rows.Count).End(xlUp).Row
      For xttt = 3 To rrttt
      If Cells(xttt, "C") = "PER" Or Cells(xttt, "C") = "FXG" Or Cells(xttt, "I") = "FXGF" Or Cells(xttt, "C") = "R.O." Or Cells(xttt, "C") = "GIU" Or Cells(xttt, "C") = "PEN" Or Cells(xttt, "C") = "CCC" Or Cells(xttt, "C") = "NIDO" Or Cells(xttt, "C") = "K" Then
      Range("A" & xttt & ":" & "F" & xttt).ClearContents
      End If
      Next xttt
      
      'rrrt = Range("M" & Rows.Count).End(xlUp).Row 'cancella nella colonna usciti
      'For xXtt = 3 To rrrt
      ' If Cells(xXtt, "M") = "?" Or Cells(xXtt, "M") = "F" Or Cells(xXtt, "M") = "NIDO" Or Cells(xXtt, "M") = "GIU" Or Cells(xXtt, "M") = "PEN" Or Cells(xXtt, "M") = "K" Or Cells(xXtt, "M") = "CCC" Then
      ' Range("K" & xXtt & ":" & "N" & xXtt).ClearContents
      ' End If
      ' Next xXtt 'fine 6
      
      Range("A3:F" & rt).Select 'ordina alfabetico colonna movimenti
      Selection.Sort Key1:=Range("E3"), Order1:=xlAscending, Header:=xlGuess, _
      OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
      DataOption1:=xlSortNormal
      Range("G3:J1700").Select 'ordina alfabetico colonna entrati
      Selection.Sort Key1:=Range("G3"), Order1:=xlAscending, Header:=xlGuess, _
      OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
      DataOption1:=xlSortNormal
      Range("K3:N1700").Select ' ordina alfabetico colonna usciti
      Selection.Sort Key1:=Range("K3"), Order1:=xlAscending, Header:=xlGuess, _
      OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
      DataOption1:=xlSortNormal
      Range("G8").Select
      Set sh1 = Worksheets("stampa movimenti")
      sh1.Activate
      Application.ScreenUpdating = False
      st = Cells(2, 16)
      cp = Cells(2, 17)
      Cells(1, 18) = Cells(Rows.Count, 5).End(xlUp).Row
      r1 = Cells(1, 18)
      Cells(1, 19) = Cells(Rows.Count, 7).End(xlUp).Row
      Cells(1, 20) = Cells(Rows.Count, 11).End(xlUp).Row
      Cells(2, 18).Select
      ActiveCell.FormulaR1C1 = "=LARGE(R[-1]C:R[-1]C[2],1)"
      rt = Cells(2, 18)
      Range(Cells(1, 18), Cells(2, 20)).ClearContents
      If r1 < rt Then
      If r1 = 2 Then
      Range(Cells(r1 + 1, 1), Cells(rt, 4)).Select
      Selection.Insert Shift:=xlDown
      Cells(4, 5).Copy
      Range(Cells(r1 + 1, 1), Cells(rt, 4)).Select
      ActiveSheet.Paste
      Application.CutCopyMode = False
      Else
      Range(Cells(r1 + 1, 1), Cells(rt, 6)).Select
      Selection.Insert Shift:=xlDown
      End If
      End If
      If r1 < rt Then d = rt Else d = r1
      Range("A3:F" & d).Select
      Selection.Sort Key1:=Range("A3"), Order1:=xlAscending, Header:=xlGuess
      For xt = 3 To d Step 2
      Range(Cells(xt, 1), Cells(xt, 14)).Interior.ColorIndex = 45 ' colora di arancione un rigo si e uno no
      Next xt
      'Range("A3:N" & r).Select 'seleziona l'area di stampa'
      'ind = Range("A3:N" & rt).Address
      'ActiveSheet.PageSetup.PrintArea = ind
      'With ActiveSheet.PageSetup
      ' .PrintTitleRows = "$1:$2"
      ' .PrintTitleColumns = ""
      'End With
      'With ActiveSheet.PageSetup
      ' .LeftHeader = " &D - &T &P/&N" 'stampa data ora e numero di pagine'
      ' .CenterHeader = "" & Chr(10) & "" & Chr(10) & "" & Chr(10) & "" & Chr(10) & "" & Chr(10) & _
      ' "&""Arial""&12U F F I C I O P O S T A&""Arial,Normale""&10" & Chr(10) & _
      '"&""Arial""&12" 'intestazione pagina'
      ' .LeftMargin = Application.InchesToPoints(0.1) 'margine sinistro della stampa'
      ' .RightMargin = Application.InchesToPoints(0.1) 'margine destro'
      ' .TopMargin = Application.InchesToPoints(1.6) 'margine alto'
      ' .BottomMargin = Application.InchesToPoints(0.25) 'adatta lo scritto alla pagina della stampa'
      ' .HeaderMargin = Application.InchesToPoints(0.1) 'abbassa o alza il titolo della pagina di stampa'
      ' .FooterMargin = Application.InchesToPoints(0.2) 'abbassa o alza lo scritto sotto la pagine'
      ' .PrintHeadings = False
      ' .PrintGridlines = False
      ' .PrintComments = xlPrintNoComments
      ' .CenterHorizontally = False
      ' .CenterVertically = False ' .Orientation = xlLandscape 'stampa in verticale...per stampare in orizzontale sostituisci con =x1portrait'
      ' .Draft = False
      ' .PaperSize = xlPaperA4 'tipo di foglio usati per la stampa'
      ' .FirstPageNumber = xlAutomatic
      ' .Order = xlDownThenOver
      ' .BlackAndWhite = False
      ' .Zoom = 100 'ingrandisce o rimpiccolisce la stampa'
      ' .PrintErrors = xlPrintErrorsDisplayed
      'End With
      'Application.ScreenUpdating = True
      'If st = "V" Then ActiveWindow.SelectedSheets.PrintPreview
      'If st = "S" Then ActiveWindow.SelectedSheets.PrintOut Copies:=cp
      If r1 < rt Then
      Range(Cells(r1 + 1, 1), Cells(rt, 4)).Select
      Selection.Delete Shift:=xlUp
      End If
      Cells(2, 1).Select
      Sheets("archivio").Select
      
      'Sub aggiorna1() 'aggiorna i nominativi, movimenti, entrati e usciti
      Dim Gh As Long
      Dim Kh As Long
      Set sh1 = Worksheets("Archivio")
      sh1.Activate
      Gh = Cells(Rows.Count, 7).End(xlUp).Row + 1
      Range(Cells(3, 7), Cells(Gh, 10)).ClearContents
      Kh = Cells(Rows.Count, 11).End(xlUp).Row + 1
      Range(Cells(3, 11), Cells(Kh, 14)).ClearContents
      For x = 3 To Cells(Rows.Count, 1).End(xlUp).Row
      If Cells(x, 5) <> "" Then
      Cells(x, 3) = Cells(x, 5)
      Cells(x, 4) = Cells(x, 6)
      Cells(x, 5) = ""
      Cells(x, 6) = ""
      End If
      Next x
      Cells(2, 1).Select
      Range("A3:F1516").Select 'ordina alfabetico tutti i nomi'
      Selection.Sort Key1:=Range("A3"), Order1:=xlAscending, Header:=xlGuess, _
      OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
      DataOption1:=xlSortNormal
      Sheets("Archivio").Select
      Range("AB3").Select
      Selection.AutoFill Destination:=Range("AB3:AB247"), Type:=xlFillDefault
      Range("AB3:AB247").Select
      Range("B9").Select
      ActiveWorkbook.Save
      
      Application.Run "'rubricagedet.xlsm'!confronta" 'fa atticare il codice che si trova nel modulo 4
      Application.Run "'rubricagedet.xlsm'!copia_nuovo2" 'fa atticare il codice che si trova nel modulo 4
      Application.Run "'rubricagedet.xlsm'!trova1" 'fa attivare il codice che si trova sotto alla fine
      Range("B9").Select
      
      Application.CutCopyMode = False
      Application.ScreenUpdating = True
      Range("A3").Select
      
      End Sub
      
      Sub trova1() 'rende visibile la finestra per cercare i nomi
      If userform1.Visible = False Then userform1.Show False
      userform1.Left = 345 'coordinate dove far apparire la finestra destra sinistra
      userform1.Top = 200
      End Sub

      il file è scaricabile da qui

      • Questo argomento è stato modificato 2 settimane, 2 giorni fa da  DOMENICO04.
    • DOMENICO04
      Partecipante
        Post totali: 16

        scusate ho dimenticato di dirvi che il copia incolla deve iniziare dalla fine del foglio, infatti se si guarda il codice inizia da

        Range(“sr1:if2489”).Select Selection.Copy Range(“ii1”).Select ActiveSheet.Paste

        quindi le uniche sei colonne vuote sono N:R

        poi sono di due in due da un range ad un altro

        il file allegato fa vedere alcune colonne ma il file originale ha nome e dati a partire dalle ultime colonne di excel

        iniziare dalla fine sembrerà forse un po strano, ma spiegare il motivo è complicato e si rischia non capirci

        excel 2013

        • Questa risposta è stata modificata 2 settimane, 2 giorni fa da  DOMENICO04.
      • BySalvBySalv
        Amministratore del forum
          Post totali: 319

          Ciao Domenico, il tuo file finisce di complicare le cose, con il codice che hai postato.

          Partiamo dal principio,

          la prima cosa le celle unite andrebbero tolte, Excel le vede come fumo negli occhi, ma ne parleremo alla fine.

          da quello che vedo dal codice e dal file, nel file il foglio è unico, nel codice i fogli sono diversi, inoltre si parla di giorni su quale data vediamo i giorni.

          Però ho capito di cosa si tratta, e mi sembra di aver già trattato l’argomento, devo vedere se riesco a risalire all’argomento dai miei archivi, ti mando un messaggio, e torno al discorso

          credo che dovresti avere un elenco unico con le date e da quello poi ricavare i vari spostamenti che avvengono nel corso del tempo .

          allega i file su

          https://www.filedropper.com/

          non ti chiede coockie o trattamento dati personali.

          Ciao By Sal :bye:

           

           

        • DOMENICO04
          Partecipante
            Post totali: 16

            copia xdy1:xed(fino all’ultima cella piena)
            incolla xeo1:xet
            copia xee1:xeh(fino all’ultima cella piena)
            incolla xeu1:xex
            copia xei1:xel(fino all’ultima cella piena
            incolla xey1:xeb

            se esce una finestra che chiede qualsiasi cosa (tipo nelle celle in cui si sta tentando di incollare ci sono altri dati elimina i dati e incolla quelli nuovi)eliminarla e procedere a incollare

            copia xdi1:xdn(fino all’ultima cella piena)
            incolla xdy1:xed
            copia xdo1:xdr(fino all’ultima cella piena)
            incolla xee1:xeh
            copia xds1:xdv(fino all’ultima cella piena)
            incolla xei1:xel

            se esce una finestra che chiede qualsiasi cosa (tipo nelle celle in cui si sta tentando di incollare ci sono altri dati elimina i dati e incolla quelli nuovi)eliminarla e procedere a incollare
            e così via dicendo

            quanto si arriva alle prime colonne cambia solo una volta e cioè
            copia A1:F(fino all’ultima cella piena)
            incolla in s1:X
            copia g1:j(fino all’ultima cella piena)
            incolla Y1:ab
            copia k1:n(fino all’ultima cella piena)
            incolla ac1:af

            mentre all’inizio lascia due celle vuote ogni tris di copia incolla, all’ultimo lascia 4 celle vuote.

            tutto questo avviene in un foglio solo che si chiama “stampa movimenti”
            non far caso alle celle colorate.
            dopo aver fatto questo dovremmo collegare un codice a un tasto che premuto faccia stampare
            questi dati che abbiamo copiato e incollato mettendoli una sopra l’altro ogni tris e ti riallego un file con esempio fatto un po meglio.
            Penso sia meglio copiare i dati in un foglio chiamato “prova” e mi deve permettere di digitare un numero che corrisponde a ogni tris che sarebbe ad esempio a:n che corrisponde a un giorno

            http://www.filedropper.com/cartel1_7

          • DOMENICO04
            Partecipante
              Post totali: 16

              by salv se ho chiesto troppo facciamo almeno il primo quesito senza preoccuparci della parte “stampa”
              grazie

            • DOMENICO04
              Partecipante
                Post totali: 16

                Non mi aiuta nessuno?

              • sidsid
                Moderatore
                  Post totali: 437

                  Ciao….BySalv sarà impegnato; provo a darti una mano iniziando dalla copia dei dati

                  copia xdy1:xed(fino all’ultima cella piena)
                  incolla xeo1:xet
                  copia xee1:xeh(fino all’ultima cella piena)
                  incolla xeu1:xex
                  copia xei1:xel(fino all’ultima cella piena
                  incolla xey1:xeb

                  Scusa ma non capisco perchè partire da fine foglio e tornare indietro; se parti dall’inizio è la stessa cosa non trovi?

                • DOMENICO04
                  Partecipante
                    Post totali: 16

                    Il primo tris di colonne cambia ogni giorno e me lo devo copiare nel secondo tris di colonna spostando questo in avanti in modo da non perdere mai nessun dato e restando in ordine di giorni. Si può fare anche come dici tu, credo, l’importante è che sia una sequenza giusta.

                  • DOMENICO04
                    Partecipante
                      Post totali: 16

                      Non so se mi sono spiegato bene In pratica il primo tris di colonne,  Facciamo conto che giorno 1 oggi, il giorno 2 si deve trovare sul secondo tris, il terzo giorno sul terzo tris , il 4 giorno sul quarto triste e così via…. Nello stesso tempo il secondo tris giorno 2 si deve trovare sul terzo tris, il giorno 3 si deve trovare sul quarto tris e così via.

                    • DOMENICO04
                      Partecipante
                        Post totali: 16

                        Perché se il primo tris va a copiare sul secondo tris quest’ultimo non deve essere cancellato ma spostato al Tris successivo

                      • sidsid
                        Moderatore
                          Post totali: 437

                          Ok..capito il funzionamento
                          Curiosità: ogni blocco di 3 tris contiene sempre valori oppure possiamo trovarlo anche vuoto?

                        • DOMENICO04
                          Partecipante
                            Post totali: 16

                            Può capitare anche vuoto uno dei tre o due  o tutti e tre

                            • Questa risposta è stata modificata 14 ore, 47 minuti fa da  DOMENICO04.
                          • sidsid
                            Moderatore
                              Post totali: 437

                              Perchè 3 tris quando puoi benissimo considerare i 3 range come range unico?

                              Se dici:
                              copia xdy1:xed(fino all’ultima cella piena)
                              incolla xeo1:xet
                              copia xee1:xeh(fino all’ultima cella piena)
                              incolla xeu1:xex
                              copia xei1:xel(fino all’ultima cella piena
                              incolla xey1:xeb

                              è la stessa cosa sostenere
                              copia XDY1:XEL (ultima cella piena)
                              incolla XEO1 :XFB

                            • DOMENICO04
                              Partecipante
                                Post totali: 16

                                <span style=”box-sizing: border-box; font-weight: bold; color: #707070; font-family: Roboto, Arial, Helvetica, sans-serif; font-size: 12px;”>Perché xdy1:xed puo contenere di più o meno righe piene nei confronti di  xee1:xeh </span>

                              Devi essere loggato per rispondere a questa discussione.

                              Utilizzando il sito, accetti l'utilizzo dei cookie da parte nostra. maggiori informazioni

                              Questo sito utilizza i cookie per fornire la migliore esperienza di navigazione possibile. Continuando a utilizzare questo sito senza modificare le impostazioni dei cookie o cliccando su "Accetta" permetti il loro utilizzo.

                              Chiudi