Creating a excel sheet from part of another, save and repeat

[Andyg666]

I have an excel sheet and I need to copy certain cells (not all the cells in the file) across into another workbook and then save the new workbook into a folder with the filename being a combination of the cells we copied across.

I have attached an image of the two files and I have manually filled in the detail as an example of the final sheet (Plant ID, ID and Location)
This then needs to save as filename 14 ??? - Gravity valve.

there are hundreds of these i need to format so I hope to automate this.

Thanks,
Andy

 

[Kaper]

My proposition is to prepare a template sheet with all needed formatting and extra texts (like DCV legend and so on).
So the workbook has 2 sheets: Tasks and Template
for each row in tasks:
- create a copy of template sheet
- write (not copy, to keep template formatting) data from specific cells (note reference to Tasks cells with dot at the beginning)
- (optional) change name of the sheet forom "Template"
- save file with name based on columns A and D - note that question marks are not allowed in a filesystem in names, so they hae to be substituted with some other characters
- close the new file

Sub FillTemplateAndSaveForAll()
Dim lastrow As Long, i As Long, temparr As Variant, nameforsaveas As String
Application.ScreenUpdating = False
With Sheets("Tasks") ' this is the only place we refer to source sheetname - you can change it here to fit your workbook
  .Activate
  lastrow = .Cells(.Rows.Count, "A").End(xlUp).Row
  For i = 2 To lastrow
    Sheets("Template").Copy 'it is now a new, one worksheet workbook
    Range("C3").Value = .Range("A" & i).Value 'contents of C3 in new file is taken from cell Tasks!A2
    Range("G3").Value = .Range("D" & i).Value 'ID is copied (value only) from B2 (and next rows)
    ' if other single cells a re to be copied do it the same way
    If InStr(.Range("C" & i).Value, vbLf) > 0 Then 'column C contains (seems to) names with new line added by Alt+Enter, so if that's true
      temparr = Split(.Range("C" & i), vbLf)
      Range("C4").Resize(UBound(temparr) + 1).Value = Application.Transpose(temparr) 'write splitted in separate lines
    Else
      Range("C4").Value = .Range("C" & i).Value ' if write whole contents of C in one cell - it is the same way as ID, Plant Etc
    End If
    ActiveSheet.Name = "Sheet1" ' restore standard sheet name, you can use also "Inspection" or "Inspection of ID " & Range("G3").Value
    nameforsaveas = Replace(Range("G3").Value & " " & Range("C3").Value, "?", "_") ' question marks are not alloved in filename
    ActiveWorkbook.SaveAs Filename:="C:\Users\Kaper\Tests\" & nameforsaveas & ".xlsx", FileFormat:=xlOpenXMLWorkbook 'of course change the file path
    DoEvents 'Just in case of slow saving, etc.
    ActiveWorkbook.Close False
    DoEvents
  Next i
End With
Application.ScreenUpdating = True
End Sub