Dim i As Long For i = 2 To Sheets.Count ActiveWorkbook.Sheets(i).Select ActiveSheet.Copy ActiveWorkbook.SaveAs ThisWorkbook.Path & "\" & ActiveSheet.Name & ".xlsx" ActiveWorkbook.Close Next