所以基本上,我想在我的一个工作表上创建一个超链接,允许我完全复制它,没有几个单元格。
我在Microsoft支持网站上发现了这一点,它允许工作表完全重复:
Sub Copier1()
ActiveWorkbook.Sheets("Invoice").Copy _
after:=ActiveWorkbook.Sheets("Invoice")
End Sub
更好的例子,我正在制作发票生成器。我可以输入价格和产品,以及计算总数。我正在尝试创建一个简单的按钮,在新的工作表中创建一个空白的新发票,同时使我的发票号码增加1。
具有透明红色的单元格是不应复制的单元格。虽然,它们包含应该复制的公式。有没有办法在“重置”它并将发票号码加1时复制完整的工作表? 需要“重置”的所有单元格都可以在宏中进行硬编码,因为发票布局始终是相同的。
我怎样才能做到这一点?
答案 0 :(得分:1)
我认为在你拥有一个可用的系统之前你还有很长的路要走,但这里有一个如何做你要求的例子。请注意,其中很多是非常手动的(所有Range
内容),这使得它很危险 - 如果您重新排列工作表上的内容,则必须相应地修改代码。我强烈建议Access执行这样的任务,这非常值得学习曲线。另外,我没有在下面这样做,但您可能想要更改新工作表的名称。
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
答案 1 :(得分:1)
这会复制工作表,然后清除产品信息
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