Hello,
Please try this code :
Sub SplitWB()
Dim wb As Workbook
Dim ar
Dim i As Long
Application.ScreenUpdating = False
ar = ThisWorkbook.Sheets("Sheet1").Cells(1).CurrentRegion.Value
For i = 2 To UBound(ar, 1)
Set wb = Workbooks.Add
With wb
With .Sheets.Add
.Name = "Notes"
.Range("A1") = "Notes"
.Range("B1") = ar(i, 9)
End With
With .Sheets.Add
.Name = "Other"
.Range("A1").Resize(3, 1) = Application.Transpose(Array("Annual", "Salary", "Additions"))
.Range("B1") = ar(i, 4)
.Range("B2") = ar(i, 7)
.Range("B3") = ar(i, 8)
End With
With .Sheets.Add
.Name = "Basic"
.Range("A1").Resize(5, 1) = Application.Transpose(Array("Name", "Date", "Nationality", "Unit", "Class"))
.Range("B1") = ar(i, 1)
.Range("B2") = ar(i, 2)
.Range("B3") = ar(i, 3)
.Range("B4") = ar(i, 5)
.Range("B5") = ar(i, 6)
End With
.SaveAs ThisWorkbook.Path & "\" & ar(i, 1) & ".xlsx"
End With
Next i
Application.ScreenUpdating = True
MsgBox "Done !"
End Sub
Bookmarks