I have created a macro which takes values from the value sheet and creates a new workbook and paste these . but i need formulas too from PtoS

Zeenation

New Member
Joined
Nov 30, 2020
Messages
6
Office Version
  1. 365
  2. 2016
Platform
  1. Windows
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
 

Excel Facts

Highlight Duplicates
Home, Conditional Formatting, Highlight Cells, Duplicate records, OK to add pink formatting to any duplicates in selected range.
I want to show formula for some cells if it carries formula other then sumif formula
 
Upvote 0

Forum statistics

Threads
1,214,584
Messages
6,120,387
Members
448,957
Latest member
Hat4Life

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top