Nel caso possa essere utile a qualcuno riporto qui una macro che ho scritto scopiazzando ed adattando varie macro trovate sia qui che su altri forum.
La Macro di seguito riportata esegue i seguenti comandi:
* +1 alla numerazione progressiva
* stampa
* salva con con nome in una directory specifica prelevando dati dalle celle
* cancella i dati inseriti nel foglio che si usa come template
- Codice: Seleziona tutto
Sub Macro1()
a = Cells(2, "s")
a = a + 1
Cells(2, "s") = a
ActiveWindow.SelectedSheets.PrintOut Copies:=1
Cartella = "C:\.........\" 'percorso completo su cui salvare, ricordarsi la barra inversa alla fine!
NomeFile = Range("S6").Value & Range("AJ1").Value & Range("S2").Value 'cella da cui prendere il nome file
NomeFoglio = "foglio1" 'nome esatto del foglio da copiare
If NomeFile = "" Then Exit Sub
If Right(NomeFile, 4) <> ".xls" Then NomeFile = NomeFile & ".xls"
Sheets(NomeFoglio).Copy
ActiveWorkbook.SaveAs Filename:=Cartella & NomeFile, FileFormat:= _
xlNormal, Password:="", WriteResPassword:="", ReadOnlyRecommended:=False _
, CreateBackup:=False
Windows("nome_file.xlsm").Activate
Sheets("foglio1").Select
Range( _
"S6:AH6,S7:AH7,S8:AH8,E11:G12,M11:M12,O11:O12,Q11:Q12,U18:AG18,T19:AG19,T20:AG20" _
).Select
Range("T20").Activate
Selection.ClearContents
Range("S6:AH6").Select
ActiveWorkbook.Save
ActiveWorkbook.Close
End Sub
********************************************************
Nello specifico:
Questo pezzo effettua la numerazione progressiva in una determinata cella. Qui (2, "s") indica, nel mio caso, la cella "S2"
- Codice: Seleziona tutto
Sub Macro1()
a = Cells(2, "s")
a = a + 1
Cells(2, "s") = a
Invia alla stampante
- Codice: Seleziona tutto
ActiveWindow.SelectedSheets.PrintOut Copies:=1
Questo pezzo salva il file in un percorso specifico usando per il nome il contenuto di una cella
- Codice: Seleziona tutto
Cartella = "C:\.........\" 'percorso completo su cui salvare, ricordarsi la barra inversa alla fine!
NomeFile = Range("S6").Value & Range("AJ1").Value & Range("S2").Value 'cella da cui prendere il nome file
NomeFoglio = "foglio1" 'nome esatto del foglio da copiare
If NomeFile = "" Then Exit Sub
If Right(NomeFile, 4) <> ".xls" Then NomeFile = NomeFile & ".xls"
Sheets(NomeFoglio).Copy
ActiveWorkbook.SaveAs Filename:=Cartella & NomeFile, FileFormat:= _
xlNormal, Password:="", WriteResPassword:="", ReadOnlyRecommended:=False _
, CreateBackup:=False
Questo pezzo cancella di dati dal foglio in cui si è lavorato, salva il foglio pulito (ma con la numerazione progressiva) e chiude il file.
- Codice: Seleziona tutto
Windows("nome_file.xlsm").Activate
Sheets("foglio1").Select
Range( _
"S6:AH6,S7:AH7,S8:AH8,E11:G12,M11:M12,O11:O12,Q11:Q12,U18:AG18,T19:AG19,T20:AG20" _
).Select
Range("T20").Activate
Selection.ClearContents
Range("S6:AH6").Select
ActiveWorkbook.Save
ActiveWorkbook.Close