Prova una macro come questa:
- Codice: Seleziona tutto
Sub eleinad()
Dim DataStart As String, SerieSt As Long, Serie1st As String, I As Long, LastA As Long
'
myPath = "C:\Users\UTENTE\Desktop\DA_PC-FACILE\" '<<< Directory in cui si scriveranno
' i nuovi file
DataStart = "A1" '<<< L' inizio dei dati
Sheets(1).Select
LastA = Cells(Rows.Count, 1).End(xlUp).Row
SerieSt = Range(DataStart).Row: Serie1st = Cells(SerieSt, 1)
For I = Range(DataStart).Row To LastA + 2
If Cells(I, 1).Value <> Serie1st Then
ActiveSheet.Copy
Cells(I, 1).Resize(LastA - 1 + 1, 1).EntireRow.Select
Cells(I, 1).Resize(LastA - 1 + 1, 1).EntireRow.Delete
If SerieSt > 1 Then _
Cells(1, 1).Resize(SerieSt - 1, 1).EntireRow.Delete
ActiveWorkbook.SaveAs Filename:= _
myPath & Cells(1, 1).Value & ".xlsx", FileFormat:= _
xlOpenXMLWorkbook, CreateBackup:=False
ActiveWorkbook.Close
SerieSt = I: Serie1st = Cells(I, 1).Value
End If
Next I
End Sub
Personalizza le linee marcate <<<; in particolare la Directory in cui i file saranno salvati deve esistere, e nell' istruzione deve essere seguita dalla "\"; suggerisco di fare le prove in una directory vuota.
Le istruzioni per il salvataggio sono per XL2010; se usi una versione precedente usa invece
- Codice: Seleziona tutto
ActiveWorkbook.SaveAs Filename:= _
myPath & Cells(1, 1).Value & ".xls", FileFormat:=xlNormal, _
Password:="", WriteResPassword:="", ReadOnlyRecommended:=False, _
CreateBackup:=False
Ovviamente dovresti garantire che in colonna A non siano usati caratteri incompatibili con la convenzione dei nomi file di windows...
Se quanto scritto sopra non e' adattabile alla tua situazione allora spiega perche' il risultato non e' idoneo e metti in linea un file campione da usare per le prove congiunte.
Ciao