Run Time Error on Save As

[rex759]

Hello,

I wrote a macro that creates a workbook for every row of a worksheet. I can get it to run 2-3 times without an error but then all of a sudden, I get a Run-time error 1004, Method SaveAs of object _workbook failed. The line that is highlighted is NewBook.Saveas Path & Range(“B20”) & “_display Template.xlsx”.

When I hit debug, then hit F5, it continues to process fine. Not sure why its getting hung up. I have One Drive turned off during the procedure.

Any advice is appreciated.

Application.DisplayAlerts = False
Application.ScreenUpdating = False

Dim ThisWorkbook As Workbook, NewBook As Workbook
Dim ThisWorksheet As Worksheet
Dim i As Integer, j As Integer, ExportCount As Integer

'Folder to store workbooks
Path = CreateObject("WScript.Shell").SpecialFolders("Desktop") & "\2021\"

'Master Workbook
Set ThisWorkbook = ActiveWorkbook
shellWB = ActiveWorkbook.Name

'Sheet2 of Master Workbook
Set ThisWorksheet = ThisWorkbook.Sheets("Sheet2")
ExportCount = 0

‘N is the number of workbooks to create entered from another macro
n = Worksheets("Instructions").Range("AA1")
'I used 2 in the 2 to 3 to skip the header row
For i = 2 To n
    If ThisWorksheet.Cells(i, 1) <> "" Then
    'NewBook = adding a new workbook to save the frist row
    Set NewBook = Workbooks.Add
        
    Workbooks(shellWB).Worksheets("master").Copy before:=NewBook.Worksheets("Sheet1")

'this Loop copies the first row of data from sheet1 to column O
'153 is the number of categories plus the comments
        For j = 1 To 153
            If ThisWorksheet.Cells(i, j) <> "" Then
                NewBook.Worksheets("Master").Cells(j, 15) = ThisWorksheet.Cells(i, j)
            End If
        Next j

'Remove Links
With NewBook.Worksheets("Master")
  .Range("B20:G116").Copy
  .Range("B20:G116").PasteSpecial Paste:=xlPasteValues, operation:=xlNone, skipblanks:=False, Transpose:=False
  Application.CutCopyMode = False

'Remove helper column
  .Columns("O").Delete
 
 'Protect workbook
  .Protect "admin"
End With


Application.StatusBar = "Saving Completed Template...."
'Save workook
 With NewBook
    .Sheets("Sheet1").Delete
    .Sheets("Sheet2").Delete
    .Sheets("Sheet3").Delete
    .Sheets("Master").Name = "Template"
  '  .SaveAs Path & Range("B20") & "_Display Template.xlsx"
 End With
 
'Save Workbook
[B]NewBook.SaveAs Path & Range("B20") & "_Display Template.xlsx"[/B]

'Close workbook
NewBook.Close False

 

[rex759]

I believe I have resolved the issue. I unticked the sync settings in One Drive and since then, it works without incident.

 

[rex759]

So I was wrong, the issue isn't one drive. The macro runs for about 5 workbooks and then it gets hung up here:

   NewBook.SaveAs Filename:=FPath & "\" & Number & Name

I was also getting this message when closing the workbook, Error "the picture is too large and will be truncated", I followed the steps to clear the %temp% folder but code is still stopping after 5-6 workbooks. I can just press the F5 to continue which works fine but its annoying as to why its happening