Sviluppare funzionalita su Microsoft Office con VBA Macro per generare fogli e salvarli in nuovi documenti

Login Registrati
Stai vedendo 20 articoli - dal 1 a 20 (di 20 totali)
  • Autore
    Articoli
  • #11433 Score: 0 | Risposta

    mek_1981
    Partecipante

      Buongiorno a tutti e grazie per avermi accolto nella vostra comunity... 🙂

      Vi scrivo perchè ho un problema che purtroppo per la mia non conoscenza di programmazione VBA non riesco a risolvere.

      Ho un file con una tabella che cambia in valori (numeri e quantità) e devo generare tanti fogli excel quanti sono i numeri presenti nella colonna prestabilita.
      Fino a qui ci siamo, riesco a generare i fogli excel come tab nello stesso file e riesco anche a rinominarli con il nome della cella da cui pesca.

      Devo generare 5 fogli per numero e quindi nel file di partenza mi ritrovo con una mole di tab...folle...

      Quello che vorrei fare ora è selezionare i 5 fogli appartenenti a quel codice e salvarli in un nuovo file che avrà lo stesso nome della cella di partenza.

      Esempio:
      Tabella
      123456
      334455

      Generazione dei fogli (nello stesso file) che chiamo come
      123456 Pippo
      123456 Pluto
      123456 Paperino
      334455 Pippo
      334455 Pluto
      334455 Paperino

      Ora devo creare 2 file nuovi chiamati:
      123456 e 334455
      che contengano i loro rispettivi 3 fogli

      Detta sembra semplice ma il nome cambia ogni volta come la quantità di numeri nella tabella (non come lunghezza della stringa ma come numerosità di codici).

      Ovviamente se dovessi riuscire a fare tutto in un passaggio sarebbe fantastico...creare e salvare senza che debba far partire 2 macro diverse.....

      Vi ringrazio per l'aiuto e un saluto a tutti.

      Matteo C.

      #11444 Score: 1 | Risposta

      patel
      Moderatore
        50 pts

        allega un file di esempio con la tua macro, i dati e la spiegazione

        #11613 Score: 0 | Risposta

        mek_1981
        Partecipante

          OK,

             ti allego il file come richiesto.

          Nella Pagina HEADER, trovi il pulsante per far partire la macro chiamata FOGLIO.

          Nella seconda pagina chiamata MATRICOLE ci sono i numeri di cui parlavo sopra (colonna G), numeri che possono variare in quantità, per ora te ne ho messi solo 2 ma possono essere anche un centinaio (vedi colonna D per esempio). NON ci sono mai numeri uguali ma solo numeri diversi.

          Ci sono poi i 2 fogli che volglio replicare n volte quanti sono i numeri che trovi nella collonna G del file MATRICOLE. Ciò significa che se ho 2 numeri, devo avere per ciascuno di questi numeri 2 fogli ognuno che assumerà il nome così fatto: "numeroCONTROLLI" e "numeroPRESTAZIONI"...comunque se fai partire la marco fino a qui funziona tutto e quindi vedrai che si generano 4 fogli, 2 per ciascun numero.

          Fino a qui nessun problema...ora voglio che i fogli creati vengano spostati in un altro foglio nuovo chiamato con lo stesso numero che vedi nella casella G del foglio MATRICOLE. Voglio cioè avere un nuovo foglio chiamato ad esempio A1502580 che avrà al suo interno questi 2 fogli appena creati "A1502580CONTROLLI" e "A1502580PRESTAZIONI" e un altro foglio nuovo chiamato A1502581 che avrà al suo interno gli altri 2 fogli rispettivi appena creati.

          Ovviamente quando li sposto voglio poter selezionare dove mettere i file e quindi aprire una maschera di browser per far salvare i file dove voglio io.

          A me piacerebbe fare tutto in un colpo quindi creo i fogli, creo i nuovi file e li sposto...sarebbe cool.

          Grazie mille del tuo aiuto.

          Matteo

           

           

           

          Allegati:
          You must be logged in to view attached files.
          #11625 Score: 1 | Risposta

          patel
          Moderatore
            50 pts

            mek_1981 ha scritto:
            ...ora voglio che i fogli creati vengano spostati in un altro foglio nuovo chiamato con lo stesso numero
            OK,

            foglio o file ?

            #11626 Score: 0 | Risposta

            mek_1981
            Partecipante

              mek_1981 ha scritto:

              Voglio cioè avere un nuovo foglio chiamato ad esempio A1502580 che avrà al suo interno questi 2 fogli appena creati "A1502580CONTROLLI" e "A1502580PRESTAZIONI" e un altro foglio nuovo chiamato A1502581 che avrà al suo interno gli altri 2 fogli rispettivi appena creati.

              Vorrei avere un nuovo file chiamato A1502580, che decido dove salvarlo, che contiene questi 2 fogli:

              A1502580CONTROLLI 

              A1502580PRESTAZIONI

              Grazie mille

              #11649 Score: 1 | Risposta

              patel
              Moderatore
                50 pts

                prova questa modifica e dimmi se siamo sulla buona strada

                Sub FOGLIO2()
                
                Dim i As Integer
                Dim Ans As String
                Set wb = ThisWorkbook
                    Sheets("MATRICOLE").Select
                    i = ActiveSheet.Range("G65535").End(xlUp).Row
                    For ia = 6 To i
                        wb.Sheets("CONTROLLI").Copy
                        ActiveSheet.Cells(2, 15) = wb.Sheets("MATRICOLE").Cells(ia, 7)
                        ActiveSheet.Name = wb.Sheets("MATRICOLE").Cells(ia, 8)
                    
                        wb.Sheets("PRESTAZIONI").Copy After:=ActiveWorkbook.Sheets(Sheets.Count)
                        ActiveSheet.Cells(2, 15) = wb.Sheets("MATRICOLE").Cells(ia, 7)
                        ActiveSheet.Name = wb.Sheets("MATRICOLE").Cells(ia, 9)
                           
                    Next
                
                End Sub

                puoi continuare da solo ?

                #11664 Score: 0 | Risposta

                mek_1981
                Partecipante

                  patel ha scritto:

                  prova questa modifica e dimmi se siamo sulla buona strada

                  GRANDISSIMO!!!! ieri ho smattato per tutto il giorno per trovare una soluzione...ed ecco qui...FANTASTICO!!!

                  ovviamento ho gia modificato e inserito all'interno della mia per fare la stessa cosa su tutti i fogli che avevo ma fa esattamente quanto mi aspettavo....

                  Ora, ho visto 2 cose:

                  1. Se al posto che copiare vorrei spostarli, visto che a me no servono più nel file originale, posso utilizzare il comando move al posto che copy?

                  wb.Sheets("CONTROLLI").Move

                  ActiveSheet.Cells(2, 15) = wb.Sheets("MATRICOLE").Cells(ia, 7)

                  ActiveSheet.Name = wb.Sheets("MATRICOLE").Cells(ia, 8) wb.Sheets("PRESTAZIONI").Move After:=ActiveWorkbook.Sheets(Sheets.Count)

                  ActiveSheet.Cells(2, 15) = wb.Sheets("MATRICOLE").Cells(ia, 7) ActiveSheet.Name = wb.Sheets("MATRICOLE").Cells(ia, 9)

                  solo che non funziona perchè mi muove i file originali...

                  2) una volta creati se volessi salvarli con un determinato nome che comunque io ho disponibile perchè ho il mio elenco nel file MATRICOLE, non so come fare a dare il nome in automatico sulla base dei classici valori che ci sono in elenco nel file MATRICOLE.

                  Detto questo già solo per l'aiuto dato un grandissimo GRAZIE...se poi riuscissi a darmi una mano anche su questa sarebbe fantastico.

                  P.S. ho provato ad integrare il tuo codice con il mio ma c'è qualcosa che non va perchè mi da un errore strano (errore di compilazione variabile non definita alla riga (Set Wb = ThisWorkbook), ti posto codice che ho aggiornato:

                  Sub FOGLIO()
                  
                  Dim i As Integer
                  Dim Ans As String
                  Dim ia As Integer
                  Dim sNome As String
                  Dim sPath As String
                  Set Wb = ThisWorkbook
                  
                  Ans = MsgBox("Are you continue?", vbYesNo)
                  If Ans = vbYes Then
                      Sheets("MATRICOLE").Select
                      
                      i = ActiveSheet.Range("G65535").End(xlUp).Row
                      For ia = 6 To i
                          Sheets("CONTROLLI").Select
                          Sheets("CONTROLLI").Copy After:=Sheets(Sheets.Count)
                          ActiveSheet.Cells(2, 15) = Sheets("MATRICOLE").Cells(ia, 7)
                          ActiveSheet.Name = Sheets("MATRICOLE").Cells(ia, 8)
                      
                          Sheets("PRESTAZIONI").Select
                          Sheets("PRESTAZIONI").Copy After:=Sheets(Sheets.Count)
                          ActiveSheet.Cells(2, 15) = Sheets("MATRICOLE").Cells(ia, 7)
                          ActiveSheet.Name = Sheets("MATRICOLE").Cells(ia, 9)
                     
                        Wb.Sheets("CONTROLLI").Copy
                          ActiveSheet.Cells(2, 15) = Wb.Sheets("MATRICOLE").Cells(ia, 7)
                          ActiveSheet.Name = Wb.Sheets("MATRICOLE").Cells(ia, 8)
                      
                          Wb.Sheets("PRESTAZIONI").Copy After:=ActiveWorkbook.Sheets(Sheets.Count)
                          ActiveSheet.Cells(2, 15) = Wb.Sheets("MATRICOLE").Cells(ia, 7)
                          ActiveSheet.Name = Wb.Sheets("MATRICOLE").Cells(ia, 9)
                             Next
                      
                      Ans = vbNo
                  End If '
                  
                  End Sub

                   

                  Matteo

                  #11667 Score: 1 | Risposta

                  patel
                  Moderatore
                    50 pts

                    il comando copy senza destinazione crea un nuovo workbook (cosa che non puoi fare con move), per assegnare il nome al file devi fare un Saveas.

                    Non ho capito l'errore relativo a ThisWorkbook, in questi casi è meglio allegare il file.

                    Non ho capito perché hai aggiunto al tuo il codice modificato da me, non bastava sostituirlo ?

                    #11668 Score: 0 | Risposta

                    mek_1981
                    Partecipante

                      AHAHAH hai ragione che pirla che sono, mi sono accorto ora che sostituendo mcon il tuo fai tutto in un colpo solo...va bhe dai porta pazienza...

                      Sto provando come dici tu a fare qualcosa di simile, ti allego la stringa di codice...

                      Premetto che sto provando...

                      Sub FOGLIO_2_copy_And_Generate_Folder()
                      
                      Dim i As Integer
                      Dim Ans As String
                      Dim rgn As Range
                      Dim c As Range
                      Set Wb = ThisWorkbook
                          Sheets("MATRICOLE").Select
                          i = ActiveSheet.Range("G65535").End(xlUp).Row
                          For ia = 6 To i
                              Wb.Sheets("CONTROLLI").Copy
                              ActiveSheet.Cells(2, 15) = Wb.Sheets("MATRICOLE").Cells(ia, 7)
                              ActiveSheet.Name = Wb.Sheets("MATRICOLE").Cells(ia, 8)
                          
                              Wb.Sheets("PRESTAZIONI").Copy After:=ActiveWorkbook.Sheets(Sheets.Count)
                              ActiveSheet.Cells(2, 15) = Wb.Sheets("MATRICOLE").Cells(ia, 7)
                              ActiveSheet.Name = Wb.Sheets("MATRICOLE").Cells(ia, 9)
                                 
                          Next
                      
                      Windows("Prova_Macro_Mek_2.xlsm").Activate
                      Sheets("MATRICOLE").Select
                      Set rgn = Range("G6:G200" & Cells(Rows.Count, "A").End(xlUp))
                      For Each c In rgn
                          nome = "JOB " & " - " & Range(c.Address)
                          If Len(Dir("C:\NuovaCartella" & nome, vbDirectory)) = 0 Then
                             MkDir "C:\NuovaCartella" & nome
                          End If
                      Next c
                      End Sub

                      Ho aggiunto al tuo una parte sotto che mi genera le cartelle in base al nome del file che trovo nel file MATRICOLE....e fino a qui va bene...

                      Solo che il percorso è fisso e nn riesco a farlo scegliere all'operatore.

                      E per ultimo create le cartelle il vero problema non so come salvare i file aperti nelle rispettive...

                      Anche oggi mi dedico al learning...

                      Grazie ancora

                      #11669 Score: 1 | Risposta

                      patel
                      Moderatore
                        50 pts

                        per scegliere la cartella di salvataggio prova questo esempio

                        Sub salvadialogo()
                        '
                        Dim MioNome, Cartella, NomeFile
                        MioNome = "C:\prova.xlsx"
                        Application.Dialogs(xlDialogSaveAs).Show MioNome
                        ActiveWorkbook.Close SaveChanges:=False
                        End Sub
                        #11672 Score: 0 | Risposta

                        mek_1981
                        Partecipante

                          Vediamo se ho capito bene...

                          Questa la devo mettere all'interno della mia in modo che mi permetta di salvare dove voglio giusto?

                           

                          #11674 Score: 1 | Risposta

                          patel
                          Moderatore
                            50 pts

                            esatto, prima provala con un file di prova per vedere se fa quello che desideri

                            #11675 Score: 0 | Risposta

                            mek_1981
                            Partecipante

                              Allora ho fatto una cosa del genere, cosa ne pensi?

                               

                              Sub Crea_Cartelle()
                              Dim rgn As Range
                              Dim c As Range
                              
                              Dim wbDest As Workbook
                              Dim wbSource As Workbook
                              Dim sht As Object 'potrebbe esser un grafico, una cartella, una macro ecc.
                              Dim strSavePath As String
                              Dim boxsino As Variant
                              
                              
                              boxsino = MsgBox("E' NECESSARIO INDICARE IL PERCORSO DI SALVATAGGIO" & vbNewLine & vbNewLine & "Desideri inserire il percorso manualmente?" & vbNewLine & vbNewLine & "Premi SI per scrivere direttamente il percorso" & vbNewLine & "Premi NO per selezionarlo in modalità grafica", vbYesNo)
                              
                              If boxsino = 6 Then
                              strSavePath = InputBox("Digita percorso di salvataggio (anche con copia incolla)")
                              If Right(strSavePath, 1) <> "\" Then
                                  strSavePath = strSavePath & "\"
                                  End If 'questo if permette di "completare" un percorso con la barra finale se non digitata
                              Else: strSavePath = BrowseFolder
                              End If
                              
                              Windows("Prova_Macro_Mek_2.xlsm").Activate
                              Sheets("MATRICOLE").Select
                              Set rgn = Range("G6:G100" & Cells(Rows.Count, "A").End(xlUp))
                              For Each c In rgn
                                  nome = "JOB " & " - " & Range(c.Address)
                                If Len(Dir(strSavePath & nome, vbDirectory)) = 0 Then
                                     MkDir strSavePath & nome
                                  End If
                              Next c
                              End Sub

                              In questo modo mi fa puntare alla directory che voglio io e creo le cartelle....

                              Ottimo direi...

                              Ora devo solo capire come integrare la tua...

                              Onestamente mi manca il collegamento tra la tua e la mia...

                              mi spiego meglio:

                              1. adesso con la tua creiamo i file e li separiamo in file nuovi che si chiameranno Cartel1, Cartel2 e cosi via....

                              2. Con la mia facciamo un browser fino alla path che mi interessa e creo le cartelle con i nomi giusti...

                              3. Mi manca ora di automatizzare il salvataggio di tutti i file Cartel1, Cartel2...dandogli il nome in automatico che predo dall'elenco MATRICOLE

                              Grazie mille 

                              #11680 Score: 1 | Risposta

                              patel
                              Moderatore
                                50 pts

                                se ho capito bene, col tuo ultimo codice prima scegli il percorso, poi crei le cartelle e ti manca soltanto di salvare i file, se è così basta fare un saveas ogni volta che crei una nuova cartella col copy, quindi

                                Set wb = ThisWorkbook
                                    Sheets("MATRICOLE").Select
                                    i = ActiveSheet.Range("G65535").End(xlUp).Row
                                    For ia = 6 To i
                                        wb.Sheets("CONTROLLI").Copy
                                        ActiveSheet.Cells(2, 15) = wb.Sheets("MATRICOLE").Cells(ia, 7)
                                        ActiveSheet.Name = wb.Sheets("MATRICOLE").Cells(ia, 8)
                                    
                                        wb.Sheets("PRESTAZIONI").Copy After:=ActiveWorkbook.Sheets(Sheets.Count)
                                        ActiveSheet.Cells(2, 15) = wb.Sheets("MATRICOLE").Cells(ia, 7)
                                        ActiveSheet.Name = wb.Sheets("MATRICOLE").Cells(ia, 9)
                                
                                        ActiveWorkbook.SaveAs ......
                                        ActiveWorkbook.Close
                                           
                                    Next
                                #11689 Score: 0 | Risposta

                                mek_1981
                                Partecipante

                                  Ciao E ancora Grazie del supporto...e pazienza...

                                  allora posto la versione finale funzionante:

                                  Sub Copy_And_Generate_Folder_Ver_5()
                                  
                                  Dim i As Integer
                                  Dim Ans As String
                                  Dim rgn As Range
                                  Dim c As Range
                                  
                                  Dim wbDest As Workbook
                                  Dim wbSource As Workbook
                                  Dim sht As Object 'potrebbe esser un grafico, una cartella, una macro ecc.
                                  Dim strSavePath As String
                                  Dim boxsino As Variant
                                  
                                  Dim MioNome, Cartella, NomeFile
                                  
                                  boxsino = MsgBox("E' NECESSARIO INDICARE IL PERCORSO DI SALVATAGGIO" & vbNewLine & vbNewLine & "Desideri inserire il percorso manualmente?" & vbNewLine & vbNewLine & "Premi SI per scrivere direttamente il percorso" & vbNewLine & "Premi NO per selezionarlo in modalità grafica", vbYesNo)
                                  
                                  If boxsino = 6 Then
                                  strSavePath = InputBox("Digita percorso di salvataggio (anche con copia incolla)")
                                  If Right(strSavePath, 1) <> "\" Then
                                     strSavePath = strSavePath & "\"
                                     End If 'questo if permette di "completare" un percorso con la barra finale se non digitata
                                  Else: strSavePath = BrowseFolder
                                  End If
                                  
                                  Set WB = ThisWorkbook
                                      Sheets("MATRICOLE").Select
                                      i = ActiveSheet.Range("G65535").End(xlUp).Row
                                      For ia = 6 To i
                                          WB.Sheets("Controlli").Copy
                                          ActiveSheet.Cells(2, 15) = WB.Sheets("Matricole").Cells(ia, 7)
                                          ActiveSheet.Name = WB.Sheets("Matricole").Cells(ia, 8)
                                      
                                          WB.Sheets("Prestazioni").Copy After:=ActiveWorkbook.Sheets(Sheets.Count)
                                          ActiveSheet.Cells(2, 15) = WB.Sheets("Matricole").Cells(ia, 7)
                                          ActiveSheet.Name = WB.Sheets("Matricole").Cells(ia, 9)
                                             
                                          WB.Sheets("Tracciabilità").Copy After:=ActiveWorkbook.Sheets(Sheets.Count)
                                          ActiveSheet.Cells(2, 14) = WB.Sheets("Matricole").Cells(ia, 7)
                                          ActiveSheet.Name = WB.Sheets("Matricole").Cells(ia, 10)
                                          
                                          WB.Sheets("Paint Log").Copy After:=ActiveWorkbook.Sheets(Sheets.Count)
                                          ActiveSheet.Cells(5, 11) = WB.Sheets("Matricole").Cells(ia, 7)
                                          ActiveSheet.Name = WB.Sheets("Matricole").Cells(ia, 11)
                                          
                                          WB.Sheets("FAT").Copy After:=ActiveWorkbook.Sheets(Sheets.Count)
                                          ActiveSheet.Cells(4, 43) = WB.Sheets("Matricole").Cells(ia, 7)
                                          ActiveSheet.Name = WB.Sheets("Matricole").Cells(ia, 12)
                                          
                                          ActiveSheets
                                                 
                                      MioNome = WB.Sheets("Matricole").Cells(ia, 7)
                                      Set wbDest = ActiveWorkbook
                                      wbDest.SaveAs strSavePath & MioNome
                                      wbDest.Close 'Chiude ogni cartella dopo averla salvata
                                  
                                            
                                      Next
                                  
                                  End Sub

                                  Vorrei chiederti se mi dai solo un ultimo consiglio...

                                  Prima di salvare vorrei che il foglio attivo non sia l'utlimo di quelli copiati...ma il primo che abbiamo copiato in modo tale che chi apre il file salvato incomincia a leggere dalla prima pagina e non dall'ultima.

                                  Grazie ancora

                                  Matteo C.

                                  #11690 Score: 1 | Risposta

                                  patel
                                  Moderatore
                                    50 pts

                                    basta selezionarlo, WB.Sheets("Controlli").Select

                                    #11691 Score: 0 | Risposta

                                    mek_1981
                                    Partecipante

                                      Grazie mille,

                                      smanettando ero arrivato a questo, ma non funziona:

                                      Set Wb = ThisWorkbook
                                          Sheets("MATRICOLE").Select
                                          i = ActiveSheet.Range("G65535").End(xlUp).Row
                                          For ia = 6 To i
                                              Wb.Sheets("Controlli").Copy
                                              ActiveSheet.Cells(2, 15) = Wb.Sheets("Matricole").Cells(ia, 7)
                                              ActiveSheet.Name = Wb.Sheets("Matricole").Cells(ia, 8)
                                              NomePrimoFoglio = Wb.Sheets("Matricole").Cells(ia, 8)
                                          
                                              Wb.Sheets("Prestazioni").Copy After:=ActiveWorkbook.Sheets(Sheets.Count)
                                              ActiveSheet.Cells(2, 15) = Wb.Sheets("Matricole").Cells(ia, 7)
                                              ActiveSheet.Name = Wb.Sheets("Matricole").Cells(ia, 9)
                                                 
                                              Wb.Sheets("Tracciabilità").Copy After:=ActiveWorkbook.Sheets(Sheets.Count)
                                              ActiveSheet.Cells(2, 14) = Wb.Sheets("Matricole").Cells(ia, 7)
                                              ActiveSheet.Name = Wb.Sheets("Matricole").Cells(ia, 10)
                                              
                                              Wb.Sheets("Paint Log").Copy After:=ActiveWorkbook.Sheets(Sheets.Count)
                                              ActiveSheet.Cells(5, 11) = Wb.Sheets("Matricole").Cells(ia, 7)
                                              ActiveSheet.Name = Wb.Sheets("Matricole").Cells(ia, 11)
                                              
                                              Wb.Sheets("FAT").Copy After:=ActiveWorkbook.Sheets(Sheets.Count)
                                              ActiveSheet.Cells(4, 43) = Wb.Sheets("Matricole").Cells(ia, 7)
                                              ActiveSheet.Name = Wb.Sheets("Matricole").Cells(ia, 12)
                                              
                                              Wb.Sheets("NomePrimoFoglio").Select
                                                     
                                          MioNome = Wb.Sheets("Matricole").Cells(ia, 7)
                                          Set wbDest = ActiveWorkbook
                                          wbDest.SaveAs strSavePath & MioNome
                                          wbDest.Close 'Chiude ogni cartella dopo averla salvata
                                      
                                      'Application.Dialogs(xlDialogSaveAs).Show MioNome
                                      'ActiveWorkbook.Close SaveChanges:=False
                                      
                                                 
                                          Next
                                      
                                      End Sub

                                      perchè volevo che fosse il primo floglio non da quelli dove parto a copiare ma di ciascun nuovo file che creo.

                                      Ma mi continua a dare errore ....mi dice indice non incluso nell'intervallo...

                                       

                                      #11697 Score: 1 | Risposta

                                      patel
                                      Moderatore
                                        50 pts

                                        NomePrimoFoglio è una variabile che contiene il nome, quindi non devi metterla tra virgolette

                                        Wb.Sheets(NomePrimoFoglio).Select

                                        #11704 Score: 0 | Risposta

                                        mek_1981
                                        Partecipante

                                          Ciao,

                                            innanzitutto grazie mille del tuo prezioso aiuto!!

                                          Direi che ci sono arrivato in modo diverso ma ci sono arrivato....

                                          Utili e interessanti questi 2 giorni di smanettamento e soprattutto di learning by doing.

                                          per correttezza e magari per aiuto a qualcun altro allego il codice finale utilizzato:

                                          Sub Copy_And_Generate_Folder_Ver_6_Parte_A()
                                          
                                          Dim i As Integer
                                          Dim Ans As String
                                          Dim rgn As Range
                                          Dim c As Range
                                          
                                          Dim wbDest As Workbook
                                          Dim wbSource As Workbook
                                          Dim sht As Object 'potrebbe esser un grafico, una cartella, una macro ecc.
                                          Dim strSavePath As String
                                          Dim boxsino As Variant
                                          
                                          Dim MioNome, Cartella, NomeFile, NomePrimoFoglio
                                          
                                          'faccio vedere una icona di caricamento - questa è la parte di attivazione
                                          Application.Cursor = xlWait
                                          
                                          
                                          boxsino = MsgBox("E' NECESSARIO INDICARE IL PERCORSO DI SALVATAGGIO" & vbNewLine & vbNewLine & "Desideri inserire il percorso manualmente?" & vbNewLine & vbNewLine & "Premi SI per scrivere direttamente il percorso" & vbNewLine & "Premi NO per selezionarlo in modalità grafica", vbYesNo)
                                          
                                          'Istruzione per ridurre il tempo di run perchè non visulaizza i passaggi fatti dalla macro - Parte di attivazione
                                          Application.ScreenUpdating = False
                                          
                                          If boxsino = 6 Then
                                          strSavePath = InputBox("Digita percorso di salvataggio (anche con copia incolla)")
                                          If Right(strSavePath, 1) <> "\" Then
                                             strSavePath = strSavePath & "\"
                                             End If 'questo if permette di "completare" un percorso con la barra finale se non digitata
                                          Else: strSavePath = BrowseFolder
                                          End If
                                          
                                          ' Genera Cartelle nella directory deiserata
                                          'Windows("DS PROVA MACRO.xlsm").Activate
                                          'Sheets("MATRICOLE").Select
                                          'Set rgn = Range("G6:G100" & Cells(Rows.Count, "A").End(xlUp))
                                          'For Each c In rgn
                                              'nome = "JOB " & " - " & Range(c.Address)
                                            'If Len(Dir(strSavePath & nome, vbDirectory)) = 0 Then
                                                 'MkDir strSavePath & nome
                                              'End If
                                          'Next c
                                          
                                          Set wb = ThisWorkbook
                                              Sheets("MATRICOLE").Select
                                              i = ActiveSheet.Range("G65535").End(xlUp).Row
                                              For ia = 6 To i
                                                  wb.Sheets("Controlli").Copy
                                                  ActiveSheet.Cells(2, 15) = wb.Sheets("Matricole").Cells(ia, 7)
                                                  ActiveSheet.Name = wb.Sheets("Matricole").Cells(ia, 8)
                                                  
                                                  'NomePrimoFoglio = wb.Sheets("Matricole").Cells(ia, 8)
                                              
                                                  wb.Sheets("Prestazioni").Copy After:=ActiveWorkbook.Sheets(Sheets.Count)
                                                  ActiveSheet.Cells(2, 15) = wb.Sheets("Matricole").Cells(ia, 7)
                                                  ActiveSheet.Name = wb.Sheets("Matricole").Cells(ia, 9)
                                                     
                                                  wb.Sheets("Tracciabilità").Copy After:=ActiveWorkbook.Sheets(Sheets.Count)
                                                  ActiveSheet.Cells(2, 14) = wb.Sheets("Matricole").Cells(ia, 7)
                                                  ActiveSheet.Name = wb.Sheets("Matricole").Cells(ia, 10)
                                                  
                                                  wb.Sheets("Paint Log").Copy After:=ActiveWorkbook.Sheets(Sheets.Count)
                                                  ActiveSheet.Cells(5, 11) = wb.Sheets("Matricole").Cells(ia, 7)
                                                  ActiveSheet.Name = wb.Sheets("Matricole").Cells(ia, 11)
                                                  
                                                  wb.Sheets("FAT").Copy After:=ActiveWorkbook.Sheets(Sheets.Count)
                                                  ActiveSheet.Cells(4, 43) = wb.Sheets("Matricole").Cells(ia, 7)
                                                  ActiveSheet.Name = wb.Sheets("Matricole").Cells(ia, 12)
                                                  
                                                  'ThisWorkbook.Sheets("A1502580 controlli").Activate
                                           
                                                         
                                              MioNome = wb.Sheets("Matricole").Cells(ia, 7)
                                              Set wbDest = ActiveWorkbook
                                              wbDest.Sheets(1).Select
                                              wbDest.SaveAs strSavePath & MioNome
                                              wbDest.Close 'Chiude ogni cartella dopo averla salvata
                                          
                                          'Application.Dialogs(xlDialogSaveAs).Show MioNome
                                          'ActiveWorkbook.Close SaveChanges:=False
                                          
                                                     
                                              Next
                                          
                                          'Istruzione per ridurre il tempo di run perchè non visulaizza i passaggi fatti dalla macro
                                          Application.ScreenUpdating = True
                                          
                                          'faccio vedere una icona di caricamento - questa è la parte di disattivazione
                                          Application.Cursor = xlDefault
                                          
                                          'Istruzione per ridurre il tempo di run perchè non visulaizza i passaggi fatti dalla macro - Parte di attivazione
                                          MsgBox ("Operazione conclusa")
                                          
                                          End Sub

                                          Grazie ancora dell'aiuto.

                                          Matteo

                                           

                                          #11718 Score: 0 | Risposta

                                          patel
                                          Moderatore
                                            50 pts

                                            I miei complimenti, non capita spesso di trovare utenti che si accontentano di suggerimenti invece della 'pappa pronta', è stato un piacere darti una mano.

                                          Login Registrati
                                          Stai vedendo 20 articoli - dal 1 a 20 (di 20 totali)
                                          Rispondi a: Macro per generare fogli e salvarli in nuovi documenti
                                          Gli allegati sono permessi solo ad utenti REGISTRATI
                                          Le tue informazioni: