Macro "spacchetta" fogli di lavoro

Marius44, 01/09/2015 06:39:

---

Buongiorno
Ti posto (con le mie scuse ad Alfredo) la tua macro corretta. In effetti la tua macro è corretta ma non dinamica. Assegnala ad un pulsante nel Foglio "NomeFoglio". In questo foglio però devi prima aggiungere una "convalida dati" riferita al tuo elenco in A2:A270 (io l'ho inserito nella cella G10. Quindi selezioni il nome che vuoi e lanci la macro qui sotto

Sub Macro5()
'
' Macro5 Macro
' Macro registrata il 30/08/2015 da Marina e Mauro
'

'
'Sheets("Acquaviva Beatrice").Select
'Sheets("Acquaviva Beatrice").Name = "Acquaviva Beatrice"
'Sheets("Acquaviva Beatrice").Select
'Sheets("Acquaviva Beatrice").Copy

nome = Range("G10").Text
Sheets(nome).Select         'assume il nome selezionato


Range("B2:L2").Select
'ActiveCell.FormulaR1C1 = "Acquaviva Beatrice"
ActiveCell.FormulaR1C1 = nome       '<=== sostituisce il precedente
With ActiveCell.Characters(Start:=1, Length:=18).Font
.Name = "Engravers MT"
.FontStyle = "Grassetto"
.Size = 12
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = 3
End With
Cells.Select
Selection.Copy
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Application.CutCopyMode = False
Selection.Replace What:="#N/D", Replacement:="", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False
Range("B2:L2").Select
'ActiveCell.FormulaR1C1 = "Acquaviva Beatrice"
ActiveCell.FormulaR1C1 = nome       '<=== sostituisce il precedente
With ActiveCell.Characters(Start:=1, Length:=18).Font
.Name = "Engravers MT"
.FontStyle = "Grassetto"
.Size = 12
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = 3
End With
'Range("B3:L3").Select
'la riga seguente salva il foglio ==> nome
ActiveWorkbook.SaveAs Filename:= _
"C:\Documents and Settings\Marina e Mauro\Desktop\Conferme\Definitive\" & nome & ".xls" _
, FileFormat:=xlNormal, Password:="", WriteResPassword:="", _
ReadOnlyRecommended:=False, CreateBackup:=False
'ActiveWorkbook.SaveAs Filename:= _
'"C:\Documents and Settings\Marina e Mauro\Desktop\Conferme\Definitive\Acquaviva Beatrice.xls" _
', FileFormat:=xlNormal, Password:="", WriteResPassword:="", _
'ReadOnlyRecommended:=False, CreateBackup:=False
End Sub

Ho messo un apostrofo nelle righe che non servono
Prova e fammi sapere.
Ciao,
Mario

---

mb63, 01/09/2015 13:47:

---

Buongiorno a tutti

forse sbaglio qualcosa ma mi sembra che la sub copi tutto il file e non solo il file di riferimento

eventualmente si può usare

---

Sub salvafogli()
Dim n As Long
Dim mynome As String
Dim mypath As String

mypath = "c:\archivio"
With ActiveWorkbook
For n = 2 To .Sheets.Count
mynome = .Sheets(n).Name
.Sheets(n).Copy
ActiveWorkbook.SaveAs Filename:=mypath & mynome
'ActiveWorkbook.Close
Next n
End With
MsgBox "sono stati creati " & n - 1 & " files"

End Sub

---

premesso che prima bisogna fare il copia incolla di tutti i valori dei figli

---

Sub Macro2()
'
' Macro2 Macro
'

'
ActiveWindow.ScrollWorkbookTabs Position:=xlLast
Sheets(Array("Acquaviva Beatrice", "Ajolfi Dario", "Ajolfi Paolo", _
"Ajolfi vinicio", "Albertazzi Marina", "Alessandro Bonetti", "Alfonsi Alice", _
"Altamura Sara", "Altena Elisabetta", "Amato Riccardo", "Amato Roberto", _
"Amorati Riccardo", "Argenzio Pina", "Arioldi Tiziana", "Armati Stefania", _
"Avoni Corinne", "Bacchi Thomas", "Baietti Paola", "Balassini Miriam", _
"Balboni Fabio", "Balducci Barbara", "Ballarini Elisabetta", "Balò Fabiana", _
"Baruzzi Matteo", "Battacchi Raffaella")).Select
Sheets("Acquaviva Beatrice").Activate
Sheets(Array("Battaglia Ornella", "Bechis Pier", "Beghelli Sergio", _
"Beghelli Vale", "Bella Elisabetta", "Bernabe Daniela", "Biagini Giovanni", _
"Bianca Rimondini", "Bigazzi Riccardo", "Bini Carla", "Bisato Francesco", _
"Bissani Lucia", "Bitelli Francesca", "Bombarda Ilaria", "Bontempi Maria")). _
Select Replace:=False
Sheets(Array("Acquaviva Beatrice", "Ajolfi Dario", "Ajolfi Paolo", _
"Ajolfi vinicio", "Albertazzi Marina", "Alessandro Bonetti", "Alfonsi Alice", _
"Altamura Sara", "Altena Elisabetta", "Amato Riccardo", "Amato Roberto", _
"Amorati Riccardo", "Argenzio Pina", "Arioldi Tiziana", "Armati Stefania", _
"Avoni Corinne", "Bacchi Thomas", "Baietti Paola", "Balassini Miriam", _
"Balboni Fabio", "Balducci Barbara", "Ballarini Elisabetta", "Balò Fabiana", _
"Baruzzi Matteo", "Bontempi Maria")).Select
Cells.Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
ActiveWindow.ScrollWorkbookTabs Position:=xlFirst
Sheets(Array("Acquaviva Beatrice", "Ajolfi Dario", "Ajolfi Paolo", _
"Ajolfi vinicio", "Albertazzi Marina", "Alessandro Bonetti", "Alfonsi Alice", _
"Altamura Sara", "Altena Elisabetta", "Amato Riccardo", "Amato Roberto", _
"Amorati Riccardo", "Argenzio Pina", "Arioldi Tiziana", "Armati Stefania", _
"Avoni Corinne", "Bacchi Thomas", "Baietti Paola", "Balassini Miriam", _
"Balboni Fabio", "Balducci Barbara", "Ballarini Elisabetta", "Balò Fabiana", _
"Baruzzi Matteo", "Battacchi Raffaella")).Select
Sheets("Acquaviva Beatrice").Activate
Sheets(Array("Battaglia Ornella", "Bechis Pier", "Beghelli Sergio", _
"Beghelli Vale", "Bella Elisabetta", "Bernabe Daniela", "Biagini Giovanni", _
"Bianca Rimondini", "Bigazzi Riccardo", "Bini Carla", "Bisato Francesco", _
"Bissani Lucia", "Bitelli Francesca", "Bombarda Ilaria", "Bontempi Maria")). _
Select Replace:=False
End Sub

---

modificati questa sub e poi lancia la prima vedrai che ti genera effettivamente un file per ogni foglio

Ciao

---