Question

So basically, I want to create a hyperlink on one of my worksheets that allows me to duplicate it exactly, without a few cells.

I found this on the Microsoft Support website that allows a worksheet to do duplicated exactly:

Sub Copier1()
    ActiveWorkbook.Sheets("Invoice").Copy _
       after:=ActiveWorkbook.Sheets("Invoice")
End Sub

For a better example, I am making an invoice generator. I can enter prices and products, along with calculating totals. I am trying to make a simple button that creates a new invoice in a new worksheet that is blank, along with making my invoice number go up by 1.

The cells with the transparent red are the ones that should not be copied. Although, they contain formulas that should be copied. Is there maybe a way to copy the full worksheet while 'resetting' it and adding the invoice number by 1? All cells that need to be 'reset' can be hardcoded within the macro since the invoice layout will always be the same.

enter image description here

How can I achieve this?

Was it helpful?

Solution

This copies the worksheet and then clears out the product info

Sub createNewInvoice()
'this assumes the top portion of the invoice never changes
Dim startRow As Integer
Dim startCol As Integer
Dim invNumber As Integer
Dim ws As Worksheet
Dim invCol As Integer
Dim invRow As Integer

invRow = 8
invCol = 6 'F column
startRow = 18 '18 is the first line of items
startCol = 2 'B

'get the invoice number
invNumber = CInt(ActiveWorkbook.Sheets("Invoice").Cells(invRow, invCol).Value)
'set the worksheet object
Set ws = ActiveWorkbook.Sheets("Invoice")
'copy after invoice
ws.Copy After:=ws

'update our invoice number
ws.Cells(invRow, invCol).Value = invNumber + 1
'make the worksheet active
ws.Activate
'clear out our cells with the product info
'clear the first line and delete the rest
Do While Trim(ws.Cells(startRow, startCol).Value) <> ""
    If startRow = 18 Then
        ws.Cells(startRow, startCol).EntireRow.ClearContents
    Else
        ws.Cells(startRow, startCol).EntireRow.Delete shift:=Excel.xlShiftUp
        'reset the row
        startRow = startRow - 1
    End If
    'move to the next row
    startRow = startRow + 1
Loop

'release the worksheet object
Set ws = Nothing


End Sub

OTHER TIPS

I think you have a ways to go before you will have a usable system, but here is an example of how to do what you are asking. Note that a lot of this is very manual (all the Range stuff) and that makes it dangerous - if you ever rearrange things on the sheet, you would have to modify the code accordingly. I would strongly recommend Access for such a task, it is well worth the learning curve. Also, I didn't do it below, but you may want to change the name of the new sheet.

Public Sub NewInvoice()
    Dim wksht As Worksheet
    Dim newwksht As Worksheet

    'Copy the Invoice worksheet
    Set wksht = ActiveWorkbook.Sheets("Invoice")
    wksht.Copy after:=wksht

    'The new worksheet is active, get a reference to it
    Set newwksht = ActiveSheet

    With newwksht
        'Clear all the input cells

        'Customer Info
        .Range("C7:C13").Value = ""

        'Company/Date
        .Range("F7").Value = ""
        .Range("F8").Value = .Range("F8").Value + 1 'Increment Invoice Number
        .Range("F9").Value = ""

        'Upper left Product # all the way to the lower right Line Total, however many there might be.
        .Range(.Range("B18"), .Range("B18").End(xlDown).End(xlToRight)).Value = ""
    End With
End Sub
Licensed under: CC-BY-SA with attribution
Not affiliated with StackOverflow
scroll top