Sub CreateNewWorkbooks()
Dim i As Integer
Dim NL As Worksheet
Set NL = Worksheets("NL")
Dim NL100 As Worksheet
Set NL100 = Worksheets("NL100")
NL.Select
Dim Lastcolumn As Integer
Dim Masterfile As Workbook
Set Masterfile = Application.ActiveWorkbook
Dim SingleWorkbook As Workbook
Lastcolumn = NL.Cells(NL.Rows.Count, "H").End(xlUp).Row
For i = 2 To Lastcolumn
Masterfile.Activate
Dim OperativPerson As String
Dim Department As String
OperativPerson = NL.Cells(i, 8).Value
Department = NL.Cells(i, 7).Value
Dim folderPath As String
folderPath = "C:\Users\Zeshan\Desktop\NL"
If OperativPerson <> "" Then
Dim Filepath As String
Filepath = folderPath & "\" & OperativPerson & "_" & Format(CDate(Now()), "yyyy_mm") & ".xlsx"
If Len(Dir(Filepath)) = 0 Then
'Create/Open workbook and Save under Filepath
Set SingleWorkbook = Workbooks.Add
SingleWorkbook.SaveAs Filepath
Masterfile.Sheets(Array("Master", "NL")).Copy Before:=Workbooks(OperativPerson & "_" & Format(CDate(Now()), "yyyy_mm") & ".xlsx").Sheets(1)
Workbooks(OperativPerson & "_" & Format(CDate(Now()), "yyyy_mm") & ".xlsx").Activate
Application.DisplayAlerts = False
Sheets("Sheet1").Delete
Application.DisplayAlerts = True
Else
'Select Workbook
Workbooks(OperativPerson & "_" & Format(CDate(Now()), "yyyy_mm") & ".xlsx").Activate
End If
Sheets.Add(After:=Sheets(Sheets.Count)).Name = Department
Masterfile.Activate
NL100.Select
NL100.Range("D4").Value = Department
NL100.Range("C4:S87").Select
Selection.Copy
Workbooks(OperativPerson & "_" & Format(CDate(Now()), "yyyy_mm") & ".xlsx").Activate
Worksheets(Department).Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Workbooks(OperativPerson & "_" & Format(CDate(Now()), "yyyy_mm") & ".xlsx").Save
End If
Next
End Sub
Dim i As Integer
Dim NL As Worksheet
Set NL = Worksheets("NL")
Dim NL100 As Worksheet
Set NL100 = Worksheets("NL100")
NL.Select
Dim Lastcolumn As Integer
Dim Masterfile As Workbook
Set Masterfile = Application.ActiveWorkbook
Dim SingleWorkbook As Workbook
Lastcolumn = NL.Cells(NL.Rows.Count, "H").End(xlUp).Row
For i = 2 To Lastcolumn
Masterfile.Activate
Dim OperativPerson As String
Dim Department As String
OperativPerson = NL.Cells(i, 8).Value
Department = NL.Cells(i, 7).Value
Dim folderPath As String
folderPath = "C:\Users\Zeshan\Desktop\NL"
If OperativPerson <> "" Then
Dim Filepath As String
Filepath = folderPath & "\" & OperativPerson & "_" & Format(CDate(Now()), "yyyy_mm") & ".xlsx"
If Len(Dir(Filepath)) = 0 Then
'Create/Open workbook and Save under Filepath
Set SingleWorkbook = Workbooks.Add
SingleWorkbook.SaveAs Filepath
Masterfile.Sheets(Array("Master", "NL")).Copy Before:=Workbooks(OperativPerson & "_" & Format(CDate(Now()), "yyyy_mm") & ".xlsx").Sheets(1)
Workbooks(OperativPerson & "_" & Format(CDate(Now()), "yyyy_mm") & ".xlsx").Activate
Application.DisplayAlerts = False
Sheets("Sheet1").Delete
Application.DisplayAlerts = True
Else
'Select Workbook
Workbooks(OperativPerson & "_" & Format(CDate(Now()), "yyyy_mm") & ".xlsx").Activate
End If
Sheets.Add(After:=Sheets(Sheets.Count)).Name = Department
Masterfile.Activate
NL100.Select
NL100.Range("D4").Value = Department
NL100.Range("C4:S87").Select
Selection.Copy
Workbooks(OperativPerson & "_" & Format(CDate(Now()), "yyyy_mm") & ".xlsx").Activate
Worksheets(Department).Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Workbooks(OperativPerson & "_" & Format(CDate(Now()), "yyyy_mm") & ".xlsx").Save
End If
Next
End Sub