› Sviluppare funzionalita su Microsoft Office con VBA › Macro per generare fogli e salvarli in nuovi documenti
-
AutoreArticoli
-
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
334455Generazione dei fogli (nello stesso file) che chiamo come
123456 Pippo
123456 Pluto
123456 Paperino
334455 Pippo
334455 Pluto
334455 PaperinoOra devo creare 2 file nuovi chiamati:
123456 e 334455
che contengano i loro rispettivi 3 fogliDetta 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.
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.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 ?
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
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 ?
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
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 ?
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
Vediamo se ho capito bene...
Questa la devo mettere all'interno della mia in modo che mi permetta di salvare dove voglio giusto?
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
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
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.
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...
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
-
AutoreArticoli