Copiare e salvare più fogli di lavoro in una nuova cartella. - pagina vista: volte

In molte occasioni abbiamo necessità di salvare un solo foglio di lavoro della cartella attiva, creando una nuova cartella che conterrà solo il foglio salvato.

Il metodo più semplice è sfruttare il metodo Copy, indicando il nome del foglio che intendiamo salvare, (o duplicare) in una nuova cartella.

  Sheets("Nome del foglio").Copy

Una volta copiato il foglio, è necessario usare il metodo SaveAs , indicando il percorso completo ed il nome che la nuova cartella dovrà avere. Potremo prelevare questo nome anche da una cella che contenga un dato adatto a fornire il nome della nuova cartella, ma forse è consigliabile richiamare la finestra "Salva con nome" di Windows, sceglieremo in questa finestra il percorso ed il nome da assegnare:

  Sheets("Fatture").Copy 'indichiamo il nome del foglio da copiare/salvare
  Application.Dialogs(xlDialogSaveAs).Show 'apriamo la finestra "Salva con nome". Dopo che avremo assegnato il nome e
  'selezionata la cartella di destinazione, premeremo il pulsante "Salva"



Ma se invece di un solo foglio, vogliamo copiare in contemporanea più fogli di una stessa cartella? possiamo usare un Array (una matrice) indicando, come elementi che compongono la matrice, i nomi dei fogli che intendiamo copiare, e quindi usare il metodo Copy applicato alla matrice:

   fogli = Array("fogliouno", "Database", "fatture")  'alla la variabile "fogli" assegniamo la matrice contenente i nomi
   Sheets(fogli).Copy
   Application.Dialogs(xlDialogSaveAs).Show


Nel caso invece che si debbano creare condizioni di valutazione per decidere quali fogli copiare (creando quindi un automatismo), dovremo usare un ciclo che, scorrendo tutti i fogli della cartella attiva, verifichi la condizione da definire ed assegni ad una matrice solo il nome dei fogli che corrispondono al criterio. Anche in questo caso useremo poi il metodo Copy applicato ai nomi in matrice.

Simuliamo quindi di voler copiare in una nuova cartella, solo i fogli in cui in una determinata cella (la stessa per tutti i fogli) compaia un numero positivo, usiamo la cella A1 come esempio; questa la routine (risolta con l'aiuto di Mike):

Sub CopiaFoglioSe()
Dim Ws As Worksheet
Dim iFogli() As String
Dim A
A = 1  'si inizializa a 1 il contatore che corrisponderà all'indice di matrice
For Each Ws In Worksheets    'per ogni foglio dell'insieme fogli
If Ws.[A1].Value > 0 Then     'se il valore nella cella A1 è un numero maggiore di zero
ReDim Preserve iFogli(1 To A) 'modifichiamo il contenuto della matrice aggiungendo un elemento, preservando (Preserve) 'l'eventuale contenuto precedente
iFogli(A) = Ws.Name  ' e quindi si assegna il nome del foglio al numero indice dell'elemento
A = A + 1  'si incrementa di una unità il contatore
End If
Next        'si passa al foglio successivo
If A = 1 Then Exit Sub 'si verifica che esistano fogli da copiare, altrimenti usciamo dalla routine
Sheets(iFogli()).Copy   'si copiano i fogli ora in matrice
Application.Dialogs(xlDialogSaveAs).Show
End Sub

Ricordiamoci che la nuova cartella creata e salvata, sarà la cartella attiva in quel momento, se vorremo chiuderla per ritornare alla cartella da cui sono stati copiati i fogli, potremo usare a fine routine:

   ActiveWorkbook.Close

 

Buon lavoro.

prelevato sul sito www.ennius.altervista.org