I am trying to create new workbooks for every row in a sheet.
I have been able to do this before but I am missing something this time.
It seems every section of code below works except 1.
It seems to work correctly until I get to the section that writes the values to the template.
It will even create the new files and save them with the correct file names.
But they are empty
I am pretty sure it is something in the bolded section.
I know I should be declaring variable but I believe something else is wrong also.
Thanks
I have been able to do this before but I am missing something this time.
It seems every section of code below works except 1.
It seems to work correctly until I get to the section that writes the values to the template.
It will even create the new files and save them with the correct file names.
But they are empty
I am pretty sure it is something in the bolded section.
I know I should be declaring variable but I believe something else is wrong also.
Thanks
Rich (BB code):
Sub Create_Requests()
'Get Number of Rows in PartsList Sheet
With Sheets("PartsList")
NbrOfParts = Application.Range("A:A").Cells.SpecialCells(xlCellTypeConstants).Count
MsgBox NbrOfParts
End With
Application.ScreenUpdating = False
'Process Each Row in PartsList
For I = 2 To NbrOfParts
doit = ActiveWorkbook.Worksheets("PartsList").Cells(I, 5).Value
If doit = 1 Then 'Only Process if this is True
'Assign values to variables
With Sheets("PartsList")
PartFor = Cells(I, "A").Value
RequestedBy = Cells(I, "B").Value
RequestDate = Cells(I, "C").Value
SubSystem = Cells(I, "D").Value
PartNumber = Cells(I, "F").Value
Description = Cells(I, "G").Value
Cost = Format(Cells(I, "H").Value, "##,##0.00")
MonthlyUsage = Cells(I, "J").Value
MinimumStock = Cells(I, "K").Value
MaximumStock = Cells(I, "L").Value
ReorderPoint = Cells(I, "M").Value
ReorderQty = Cells(I, "N").Value
Vendor = Cells(I, "P").Value
End With
'Write variables values to Template
With Sheets("Template")
Cells(6, "B").Value = Description
Cells(8, "B").Value = Vendor
Cells(10, "B").Value = PartNumber
Cells(12, "B").Value = Cost
Cells(23, "D").Value = PartFor '& "- (" & SubSystem & ")"
Cells(25, "C").Value = MonthlyUsage
Cells(27, "C").Value = MinimumStock
Cells(29, "C").Value = MaximumStock
Cells(31, "C").Value = ReorderPoint
Cells(33, "C").Value = ReorderQty
Cells(36, "C").Value = RequestedBy
Cells(36, "H").Value = RequestDate
End With
'Copy Template range and save it to new Workbook
ActiveWorkbook.Worksheets("Template").Range("A1:H43").Copy
Name = PartFor & " " & I
Dim WB As Workbook 'creates a reference to workbook object
Set WB = Workbooks.Add
ActiveWorkbook.Worksheets("Sheet1").Range("A1:H43").PasteSpecial xlPasteColumnWidths
ActiveWorkbook.Worksheets("Sheet1").Range("A1:H43").PasteSpecial xlPasteAll
ActiveWorkbook.SaveAs Filename:="X:\Inventory Requests\" & PartFor & "\" & Name & ".xlsx" 'saves at the given file location and name
ActiveWorkbook.Close
End If
Next I ' Get next Part from list
Application.ScreenUpdating = True
End Sub
Last edited by a moderator: