Creare una copia di un file Excel, mantenendo le macro, ma eliminando alcuni fogli

Ciao

Andiamo step by step. Perchè dimensioni delle variabili (Dim ws1, ws2 As Worksheet - attenzione che solo ws2 è un Worksheet mentre ws1 è un Variant) che poi non usi? Stesso discorso per Newbook e OldBook.

Vediamo la prima macro: con ActiveWorkbook.Save salvi il file attivo (dovrebbe essere quello di apertura); poi, con Set NewBook = ThisWorkbook dichiari un nuovo workbook che salvi come NewBook.SaveAs Filename:=ThisWorkbook.Path & "\" & "B" - Quindi selezioni il Foglio3 (Sheets("Foglio3").Select) e lo elimini ma non specifichi di quale workbook e, se non erro, quello attivo si riferisce al file A. Hai controllato che il NUOVO file contenga il Foglio3?

Non capisco quando dici "chiude il file originale". Non vedo alcun codice di chiusura!

Ciao,

Mario

Ciao Mario. Innanzitutto grazie mille per il tempo che mi stai dedicando e scusa per il disordine nella richiesta.

Cercherò di essere un po' più ordinato.

-  Dimensiono le variabili ws1 e ws2 perché avevo in progetto di assegnargli in uno step successivo di sviluppo dei nomi specifici di foglio che dovranno essere cancellati presenti nella mia cartella di lavoro. Ora per semplificare, ho inserito Foglio 3. Non sapevo assolutamente che solo ws2 è un Worksheet mentre ws1 è un Variant, ma pensavo che entrambi fossero dichiarati come Worksheet

- Con ActiveWorkbook.Save voglio salvare il file originale (A), quindi quello "base" che è aperto e dal quale andrò a estrapolarne una parte per creare il nuovo file "B" 

- Con Set NewBook = ThisWorkbook dichiaro un nuovo workbook che salvo come NewBook.SaveAs per creare il file (B) che inizialmente deve essere una copia esatta di (A), anche se probabilmente sarebbe più corretto usare l'istruzione

NewBook = ActiveWorkbook

- Quindi seleziono il Foglio3 e lo elimino nel file (B) e anche se non specifico di quale WorkBook si tratti ( cosa che sarebbe cmq meglio fare ), funziona correttamente.

Se provi ad eseguire la macro presente nel file allegato, vedrai che come viene attivata, il file (A) viene "rinominato" come file (B) e modificato correttamente, ma inevitabilmente (A) viene "chiuso" perché rinominato in (B). Io invece necessiterei che entrambe i file al temine dell'esecuzione della macro fossero aperti. Ho provato ad ottenere questo risultato con l'istruzione

    Set NewBook = Workbooks.Add

nella seconda macro. Questo effettivamente mi creava un secondo file ( senza chiudere (A) ), solo che non riesco a "duplicarvi" tutto il contenuto di (A) ed inoltre non copia i moduli contenenti le macro. 

L'istruzione 

    NewBook = OldBook

non duplica il contenuto di (A) in (B).

Per ovviare a questo problema, avevo anche pensato di inserire nella macro un comando di riapertura del file (A), ma preferirei evitare perché dovrei anche ricavare le informazioni inerenti alla posizione di (A).

Già che ci siamo, se fosse possibile, vorrei capire come riuscire a far si che se nella nuova cartella di lavoro, ipotizzando che invece che una sola macro siano contenute ad esempio le macro X, Y e Z, vengano cancellate le Macro Y e Z perché non necessarie.

Grazie mille anticipatamente per la pazienza ...

Ciao

Ho trovato a questo indirizzo questa macro che, opportunamente adeguata, dovrebbe fare il lavoro richiesto. Fai attenzione perchè è di molto tempo fa.

Sub duplica_file()
    Dim nFile As String, percorso As String
    Application.DisplayAlerts = False
    
    nFile = [a1] & "-" & [b1] & "-" & Format([c1], "dd-mm-yyyy")
    percorso = ThisWorkbook.Path

    ActiveWorkbook.SaveAs Filename:= _
                percorso & "" & nFile & ".xlsx", _
                FileFormat:=xlOpenXMLWorkbook
    
    'per salvare in formato 2003:
    'ActiveWorkbook.SaveAs Filename:= _
    '            percorso & "" & nFile & ".xls", _
    '           FileFormat:=xlExcel8
End Sub

Fai sapere se va bene. Ciao,

Mario

Grazie mille ....

Provata, ma non fa quello che vorrei, ma sicuramente è perché non riesco a spiegarmi bene.

Questa è la macro "ripulita e sistemata" in base ai suggerimenti che mi hai dato:

Sub SaveWorksheetAsNewWorkbookII()
' Salva solo alcuni fogli - Salva le Macro

    Dim WS01, WS02 As String
    Dim NomeComompletoFile As String
    Dim NewBook, OldBook As Workbook
    
    Application.DisplayAlerts = False ' Disattiva le conferme
    WS01 = "Foglio3"
    NomeCompletoFile = ActiveWorkbook.FullName
    
    'Salva il file originale di Base con le eventuali modifiche apportate prima di rinominarlo e modificarlo
    ActiveWorkbook.Save
    
    
    ' Rinomina il file originale di base creandone una copia comprensiva di Macro
    Set NewBook = ActiveWorkbook
    NewBook.SaveAs Filename:=ThisWorkbook.Path & "\" & "B", FileFormat:=xlOpenXMLWorkbook
    
    ' Elimina Foglio assegnato alla varibile WS01 dal nuovo File
    Sheets(WS01).Select
    ActiveWindow.SelectedSheets.Delete

    ' Riapre il file originale di base
    Workbooks.Open Filename:=NomeCompletoFile

    Application.DisplayAlerts = True   ' Riattiva le conferme

End Sub

Ora, come vedi, per risolvere in qualche modo il problema, ho inserito il comando Open per riaprire il file originale, ma questo, oltre a non piacermi dal punto di vista stilistico ( ma me lo faccio andar bene perché non ho trovato altra soluzione ), mi crea il problema che la cartella attiva alla fine della macro è il file originale, ma io vorre che fosse il file nuovo.

Ho provato con l'istruzione 

ActiveWorkbook.Select = NewBook

ma mi da errore in debug ... Evidentemente sbaglio qualcosa 🤣 

Oltre a questo, non so se esiste il modo per eliminare una specifica macro dal nuovo file ...

Riallego il file con la macro modificata e una macro in più che nel nuovo file andrebbe cancellata così magari da spiegarmi meglio

Grazie mille a tutti ....

Ciao

Ho "prodotto" questo codice che, credo, fa quello che vuoi. Provalo e fai sapere.

Sub Duplica_NoFoglio3()

Dim oldFile As String, newFile As String, percorso As String
    
    Application.DisplayAlerts = False
    oldFile = ActiveWorkbook.Name
    percorso = ActiveWorkbook.Path
    newFile = "\B.xlsm"
    ActiveWorkbook.SaveCopyAs Filename:=percorso & newFile
    Workbooks.Open Filename:=percorso & newFile
    ActiveWorkbook.Sheets("Foglio3").Delete
    ActiveWorkbook.Save
    Workbooks(oldFile).Activate
    Application.DisplayAlerts = True

End Sub

E' necessaria la riga  Workbooks.Open Filename:=percorso & newFile per il nuovo file è stato copiato e salvato nella cartella ma non è aperto.

Ciao,

Mario

Grande ... Funziona perfettamente ed è ordinato e pulito.

Resterebbe un unico punto: è possibile eliminare dalla sezione moduli del VBA nel nuovo file una ( o Piu ) specifiche macro ? 

Male che vada, se non fosse possibile, mi limiterò ad eliminare i pulsanti che richiamano le macro non più necessarie ...

Intanto grazie ancora !!!!

Ciao

Premesso che ti consiglierei di eliminare i pulsanti (senza macro a che servirebbero?) se vuoi eliminare TUTTE le macro dal nuovo foglio, prova con questa macro (è simile alla precedente ma un po' modificata)

Sub Duplica_NoFoglio3_NoMacro()
'
Dim oldFile As String, newFile As String, percorso As String
Dim wb As Workbook
'
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    oldFile = ActiveWorkbook.Name
    percorso = ActiveWorkbook.Path & "\"
    newFile = "B"
    ActiveWorkbook.SaveCopyAs Filename:=percorso & newFile & ".xlsm"
    Set wb = Workbooks.Open(FolderPath & percorso & newFile) 'Filename)
    ActiveWorkbook.Sheets("Foglio3").Delete
    'elimina TUTTE le macro sul nuovo file
    If wb.HasVBProject Then
      Set VBProj = wb.VBProject
      For Each vbcomp In VBProj.VBComponents
        If vbcomp.Name = "Modulo1" Then
          VBProj.VBComponents.Remove vbcomp
        End If
      Next vbcomp
    End If
    ActiveWorkbook.Save
    Workbooks(oldFile).Activate
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
End Sub

Fai sapere. Ciao,

Mario

Ciao,

la Macro funziona perfettamente ma io avrei esigenza non di eliminare TUTTE le macro presenti nel nuovo file, ma solo alcune macro specifiche ... Ma se questo non fosse possibile o risultasse anche solo troppo macchinoso, seguirò il tuo consiglio di limitarmi ad eliminare i pulsanti.

Grazie ancora ....

Ciao

Questo è l'ultimo intervento da parte mia (altrimenti facciamo un romanzo)

Copia il codice sottostante e inseriscilo nel tuo Modulo.

ATTENZIONE A QUANTO SCRITTO NELL'ULTIMA MACRO E CONTRASSEGNATO DA '<<<<<

Sub dup_noFg3_noMacro() 'DuplicaFile_EliminaFoglio3_EliminaUnaSOLAMacro()
'
Dim oldFile As String, newFile As String, percorso As String
Dim wb As Workbook
Dim VBCodeMod
Dim StartLine As Long
Dim HowManyLines As Long
'
Application.ScreenUpdating = False
Application.DisplayAlerts = False
oldFile = ActiveWorkbook.Name
percorso = ActiveWorkbook.Path & "\"
newFile = "B"
ActiveWorkbook.SaveCopyAs Filename:=percorso & newFile & ".xlsm"
Set wb = Workbooks.Open(FolderPath & percorso & newFile)
ActiveWorkbook.Sheets("Foglio3").Delete
'elimina la macro dal nuovo file
With ActiveWorkbook
  Set VBCodeMod = .VBProject.VBComponents("Modulo1").CodeModule         '<<<<< indicare il nome del Modulo in cui è presente la macro da eliminare
  With VBCodeMod
    StartLine = .ProcStartLine("dup_noFg3_noMacro", vbext_pk_Proc)      '<<<<< indicare il nome della macro da eliminare
    HowManyLines = .ProcCountLines("dup_noFg3_noMacro", vbext_pk_Proc)  '<<<<< indicare il nome della macro da eliminare
    .DeleteLines StartLine, HowManyLines
  End With
End With
ActiveWorkbook.Save
Workbooks(oldFile).Activate
Application.DisplayAlerts = True
Application.ScreenUpdating = True
Set wb = Nothing
Set VBCodeMod = Nothing
End Sub

Comunque fai sapere se funziona. Ciao,

Mario

Innanzitutto Grazie mille per la pazienza veramente infinita !!!

Ho provato la procedura, ma si blocca all'istruzione 

 Set VBCodeMod = .VBProject.VBComponents("Modulo 1").CodeModule

L'errore che mi viene dato in Debug è:

1004 : L'accesso a livello di programmazione al Progetto Visual Basic non è attendibile.

Ho provato sia con" Modulo1" come mi avevi scritto tu, che con "Modulo 1" che è il nome assegnato, sia con "Modulo_1" ( non si sa mai 🤣 ), ma non funziona 😭 😭 

Dove potrebbe essere l'errore ???

Grazie ancora !!!

Ciao

Ti allego il tuo file col quale ho fatto le prove (ti consiglio di scaricare il file e metterlo un una cartella a se stante).

Fai sapere. Ciao,

Mario

Allora ... Ho provato il tuo file ma mi da lo stesso errore 

Ti allego il mio in cui ho inserito i nomi e indicato la macro da cancellare ( eliminando tutte le altre in modo da fare "ordine e pulizia" )

Sicuramente sbaglio io ancora qualcosa, ma non so cosa ....

Ciao

Ho scariato il nuovo file; ho aggiunto la mia macro nel Modulo1; ho lanciato la macro e funziona correttamente.

Mi sorge un dubbio!! Che versione hai di Excel? Io ho la vers.2019

Ciao,

Mario

365