copy sheet - save as - 400 error

[elwood96]

Hi there,

When I test code below in blue in a blank worksheet it works fine and copies the relevant sheet to a new workbook and saves the file automatically. Great!

However, when I use this code in the workbook I want it gets as far as creating a new workbook and pasting the data, but then an error comes up saying nothing but "400", and does not complete the saving part.

I would greatly appreciate your help.


Private Sub Workbook_Open()
Sheets("Open").Activate
End Sub
Sub SaveASheet()
Dim fName As String
Dim myPath As String
Dim sht As Worksheet
myPath = "K:\3. Design\Supply Orders\Log\"
For Each sht In ThisWorkbook.Worksheets
If sht.Range("D1").Value <> "" Then
sht.Copy
With ActiveWorkbook
.SaveAs myPath & ActiveSheet.Range("G11").Value & ".xlsx"
.Close
End With
End If
Next sht

End Sub
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
If SaveAsUI = True Then
MsgBox "Please use 'Save' to Save this Workbook...", vbCritical, "Your title"
Cancel = True
End If
End Sub
Private Sub Workbook_BeforePrint(Cancel As Boolean)
If Range("f13").Value = "Update Register" Then
Cancel = True
MsgBox "You must complete the register before printing"
End If
End Sub

 

[Simon Lloyd]

chane your save code for this:

ActiveWorkbook.SaveAs (myPath & ActiveSheet.Range("G11").Value & ".xlsx")

 

[elwood96]

changed it to the following and it gives the same error. Is this correct? sorry to be a pain.


Sub SaveASheet()
Dim fName As String
Dim myPath As String
Dim sht As Worksheet
myPath = "U:\3. Design\Supply Orders\Log\"
For Each sht In ThisWorkbook.Worksheets
If sht.Range("D1").Value <> "" Then
sht.Copy
With ActiveWorkbook
ActiveWorkbook.SaveAs (myPath & ActiveSheet.Range("G11").Value & ".xlsx")
.Close
End With
End If
Next sht

End Sub

 

[jindon]

What is actually in G11 ?

 

[elwood96]

its a number. and the cell is a list box.

 

[jindon]

Then you also need to check if it has value or not.
try

With ActiveWorkbook
    If ActiveSheet.Range("G11") <> "" Then
        .SaveAs myPath & ActiveSheet.Range("G11").Value & ".xlsx"
    Else
        MsgBox "Unable to save"
    End If
    .Close False
End With

 

[elwood96]

ok. progressing, i think.

It now gives the message "unable to save"....?

 

[jindon]

Change to

Sub SaveASheet()
Dim fName As String
Dim myPath As String
Dim sht As Worksheet
myPath = "U:\3. Design\Supply Orders\Log\"
For Each sht In ThisWorkbook.Worksheets
    If (sht.Range("D1").Value <> "") * (sht.Range("g11").Value <> "") Then
        fName = myPath & sht.Range("g11").Value & ".xlsx"
        sht.Copy
        With ActiveWorkbook
            .SaveAs fName
            .Close False
        End With
    End If
Next sht
End Sub

 

[Simon Lloyd]

Well caught Jindon!, i'm being lazy now but does the same work if there is a formula in the cell but not returning a value? i.e something like =IF(A1="","",B1), so the cell is not actually blank if A1 is blank because HasFormula.

 

[jindon]

Well caught Jindon!, i'm being lazy now but does the same work if there is a formula in the cell but not returning a value? i.e something like =IF(A1="","",B1), so the cell is not actually blank if A1 is blank because HasFormula.

That's why I didn't use IsEmpty function

If (sht.Range("D1").Value <> "") * (sht.Range("g11").Value <> "") Then

And of course, he needs more to check, if the value in G11 is valid characters/length for file name or not...