Quote:
Originally Posted by NoSparks
Perhaps this...
Code:
Sub SaveInvWithNewName()
Dim NewFN
Dim variable1
Dim variable2
With ActiveSheet '<~~ this is the original invoice
' are these cells filled in?
If .Range("F16") = "" Or .Range("E31") = "" Or .Range("G31") = "" Then
MsgBox "some stuff missing"
Exit Sub
End If
variable1 = .Range("A32").Value
variable2 = .Range("A35").Value
.Copy 'creates new active workbook containing this invoice
End With
With ActiveSheet '<~~ now dealing with sheet in newly created workbook
.Range("A32").Value = variable1
.Range("A35").Value = variable2
.Cells.Locked = True
.Protect
NewFN = "C:\invoice\" & .Range("I5").Value & .Range("H5").Value & .Range("I49").Value & .Range("F16").Value
End With
With ActiveWorkbook
.SaveAs NewFN, FileFormat:=xlOpenXMLWorkbook '<~~ this will add the file extention .xlsx
Application.DisplayAlerts = True
.PrintOut From:=1, To:=1, copies:=2
.Close SaveChanges:=False
End With
Call NextInvoice
End Sub
|
Thank you for your help.
Because I want to make a first check on whether there are empty cells and send me a message and make me POSTTOREGISTER, I tried to adapt your own (I do not know if I put it at the right point) but it is a problem of drafting and finally I think that Locking the new spreadsheet does not succeed if there is any other way or is it better to save it as a pdf (I tried it but when I open it I get a message that the file is corrupted
Sub PostToRegister()
Dim Lrow As Long
Lrow = Sheets("LIST INVOICE").Cells(Rows.Count, 1).End(xlUp).Row
Dim inDate As Date, inNum As Long
inDate = Sheets("INVOICE").Cells(38, 7).Value
inNum = Sheets("INVOICE").Cells(5, 9).Value
Dim exDate, exNum As Long
exDate = Sheets("LIST INVOICE").Cells(Lrow, 1).Value
exNum = Sheets("LIST INVOICE").Cells(Lrow, 2).Value
If .Range("F16") = "" Or .Range("E31") = "" Or .Range("G31") = "" Or .Range("G38") = "" Then
MsgBox "some stuff missing"
Exit Sub
End If
If inDate >= exDate And inNum > exNum Then
Dim WS1 As Worksheet
Dim WS2 As Worksheet
Set WS1 = Worksheets("INVOICE")
Set WS2 = Worksheets("LIST INVOICE")
'Figure out which row is the next row
NextRow = WS2.Cells(Rows.Count, 1).End(xlUp).Row + 1
'Write the important values to Register
'Write the important values to Register
WS2.Cells(NextRow, 1).Resize(1, 6).Value = Array(WS1.Range("G38"), WS1.Range("I5"), WS1.Range("H5"), _
WS1.Range("F16"), WS1.Range("G31"), WS1.Range("E31"))
Else
MsgBox "ERROR"
End
End If
End Sub