Save 2 different worksheets in the same workbook using coding - vba

Question

I use Excel to do an invoice system for my company. I've had to make it "dummy proof" for some of the other employees that use the program. I use several codes to make it successful. I have two sheets: Carolina Fireworks Order Form and Back Order. There is a macro on Carolina Fireworks Order Form that copies any cells over to the Back Order Form (this is an exact copy of Carolina Fireworks Order Form except that in the C7 where customer name is placed it automatically says Customer name and BO).
I have a code that automatically saves the file into a specific folder with C7 (customer name) and current date. Is there a way that I can add a code that if I hit the macro button to copy over the BO cells that it will automatically save Back Order sheet seperately with file name C7 and current date? Then when I hit the x buttom my other code will automatically save Carolina Fireworks Order Form (sheet 1)?
Does this make sense? I'm not a code writer so I had to search forever to get the code below to work. If there is a better way to do this then I'm completely open to it! Below is the current code that I am using for Module 1:
Sub myOpenCode()
'Standard module code, like: Module1.
Dim strCustomer$, strMsg$, myUpDate$, strCustNm$
Application.EnableEvents = True
On Error GoTo myErr
strCustomer = Sheets("Carolina Fireworks Order Form").Range("C7").Value
'Test for current customer!
If strCustomer <> "" Then
strMsg = "The current customer name is:" & vbLf & vbLf & _
strCustomer & vbLf & vbLf & _
"Change this customer name to a different Name?"
'Test for customer name update?
myUpDate = MsgBox(strMsg, vbQuestion + vbYesNo, "Add Customer?")
'Chose "Yes" button!
If myUpDate = 6 Then
'Change current customer's name!
strCustNm = InputBox(strMsg, "Change Customer Name!", "")
End If
'Chose "No" button!
If myUpDate = 7 Then
'Keep current customer name!
Application.EnableEvents = True
Exit Sub
End If
Else
'Get customer name!
strMsg = "The current customer name is:" & vbLf & vbLf & _
"""EMPTY!""" & vbLf & vbLf & _
"Add a customer name:"
'Force add customer name add!
myGetCustNm:
strCustNm = InputBox(strMsg, "Add Customer Name!", "")
If strCustNm = "" Then GoTo myGetCustNm
End If
'Load customer name!
Sheets("Carolina Fireworks Order Form").Range("C7").Value = strCustNm
Application.EnableEvents = True
Exit Sub
myErr:
'GoTo Error routine!
Call myErrHandler(Err)
End Sub
Sub myCloseCode()
'Standard module code, like: Module1.
Dim strDate$, strCustomer$, strFileNm$, strMsg$, myUpDate$
Application.EnableEvents = False
On Error GoTo myErr
'Test for Save option or Exit without saving?
strMsg = "Save this file before closing?"
myUpDate = MsgBox(strMsg, vbQuestion + vbYesNo, "Save Now?")
'Chose "Yes" button!
If myUpDate = 6 Then GoTo mySave
'Chose "No" button!
If myUpDate = 7 Then
Application.EnableEvents = True
Exit Sub
End If
mySave:
'Build file name!
strDate = DatePart("m", Date) & "-" & _
DatePart("d", Date) & "-" & _
Right(DatePart("yyyy", Date, vbUseSystemDayOfWeek, vbUseSystem), 4)
strCustomer = Sheets("Carolina Fireworks Order Form").Range("C7").Value
strFileNm = "\\Owner-hp\Users\Public\Customers\" & strCustomer & "-" & strDate & ".xlsm"
'Save current file!
ActiveWorkbook.SaveAs Filename:=strFileNm
Application.EnableEvents = True
ActiveWorkbook.Close
Exit Sub
myErr:
'GoTo Error routine!
Call myErrHandler(Err)
Application.EnableEvents = True
End Sub
Private Sub myErrHandler(myErr As ErrObject)
'Standard module code, like: Module1.
'Error Trap Routine!
Dim myMsg$
'Build Error Message!
myMsg = "Error Number : " & Str(myErr.Number) & vbLf & _
"Error Location: " & myErr.Source & vbLf & _
"Error Description: " & myErr.Description & vbLf & vbLf & _
"Context: " & myErr.HelpContext & vbLf & _
"Help File: " & myErr.HelpFile
'Show Error Message!
MsgBox myMsg & vbLf & vbLf & _
"Use the ""Help"" button for more information, on this ERROR!", _
vbCritical + vbMsgBoxHelpButton, _
Space(3) & "Error!", _
myErr.HelpFile, _
myErr.HelpContext
End Sub
Module 2:
Sub CopyBO()
'Copy cells of cols A,B,D from rows containing "BO" in
'col I of the active worksheet (source sheet) to cols
'A,B,D of Sheet2 (destination sheet)
Dim DestSheet As Worksheet
Set DestSheet = Worksheets("Back Order")
Dim sRow As Long 'row index on source worksheet
Dim dRow As Long 'row index on destination worksheet
Dim sCount As Long
sCount = 0
For sRow = 1 To 65536
'use pattern matching to find "BO" anywhere in cell
If Cells(sRow, "I") Like "*BO*" Then
sCount = sCount + 1
'copy cols A,B, D
Cells(sRow, "A").Copy Destination:=DestSheet.Cells(sRow, "A")
Cells(sRow, "B").Copy Destination:=DestSheet.Cells(sRow, "B")
End If
Next sRow
MsgBox sCount & " Back Ordered rows copied", vbInformation, "Transfer Done"
End Sub

Answer 1

Below code will create a copy of Back Order Sheet when procedure CopyBO is called.
Sub CopyBO()
'Copy cells of cols A,B,D from rows containing "BO" in
'col I of the active worksheet (source sheet) to cols
'A,B,D of Sheet2 (destination sheet)
Dim DestSheet As Worksheet
Set DestSheet = Worksheets("Back Order")
Dim n_Wkb As Workbook ' new workbook
Dim strFileNm As String
Dim sRow As Long 'row index on source worksheet
Dim dRow As Long 'row index on destination worksheet
Dim sCount As Long
sCount = 0
For sRow = 1 To 65536
'use pattern matching to find "BO" anywhere in cell
If Cells(sRow, "I") Like "*BO*" Then
sCount = sCount + 1
'copy cols A,B, D
Cells(sRow, "A").Copy Destination:=DestSheet.Cells(sRow, "A")
Cells(sRow, "B").Copy Destination:=DestSheet.Cells(sRow, "B")
End If
Next sRow
If sCount > 0 Then
DestSheet.Copy
Set n_Wkb = ActiveWorkbook
' Get the file path
strCustomer = ThisWorkbook.Sheets("Carolina Fireworks Order Form").Range("C7").Value
strFileNm = "\\Owner-hp\Users\Public\Customers\" & strCustomer
strFileNm = strFileNm & Format(Now(), "DD-MM-YY hh.mm.ss") & ".xlsx"
'save
n_Wkb.SaveAs strFileNm
n_Wkb.Close
End If
MsgBox sCount & " Back Ordered rows copied", vbInformation, "Transfer Done"
End Sub