Excel VBA copy data可根据条件将数据复制到新工作簿

我有两个工作手册-数据文件（表：安得拉邦）和发票文件（在最后一张发票之后添加新发票）

我想使用数据工作簿中的透视表在发票工作簿中创建发票。每1张发票1个采购订单编号

例如：第9B行DO3566521将被复制到发票工作簿中的新发票300中，其中包含以下信息：

• 将订单关闭日期（A9）复制到I16中
• 采购订单编号DO666（B9）复制到B31中
• 将订单ID 1234（C9）复制到A34中
• 规范名称-3个项目（E9:E11）复制到B34:B36中
• 要复制到G34:G36的发票数量（F9:F11）
• 要复制到I34:36的发票金额（G9:G11）

• 采购订单编号DO667（B12）应复制到另一张新发票301中（新工作表301将添加到发票工作簿中）

我可以让发票工作簿添加/复制新的工作表，但在复制数据和编写循环函数时遇到问题。如果是不同的采购订单，如何创建新发票？任何帮助都将不胜感激

顺便说一句，我还有一个宏（

Sub Get_Spelling（）

），用于将发票工作表（A55）中的数字转换为单词。只是想知道如何将它们连接在一起，以便在创建发票时自动更新

数据工作簿-工作表名称：安得拉邦

A9                B9        C9         D9        E9        F9    G9
Order Closed Date PO Number Order ID  Item Index Spec Name Qty  Invoice Amt
15/09/11          DO666     1234        1        A         10    $100
                                        2        B         20    $200 
                                        3        C         30    $300
                  DO667     567         1        L         40    $100 
                                        2        K         50    $200 

发票工作簿-表名：发票编号（例如Inv 300）

这是我的密码：

Option Explicit

Sub Create_Invoice()
Dim oldsheet As Worksheet
Dim newSheet As Worksheet
Dim oldnumber As Integer
Dim newnumber As Integer
Dim databook As Workbook
Dim datasheet As Worksheet
Dim invbook As Workbook
Set databook = ActiveWorkbook
Set invbook = ActiveWorkbook

Application.Workbooks.Open ("C:\Users\Owner\Desktop\New folder\AP VAT Inv 201 -.xls")
'Set invbook = ActiveWorkbook

oldnumber = ActiveSheet.Name
newnumber = oldnumber + 1

ActiveSheet.Copy After:=ActiveWorkbook.ActiveSheet
Set newSheet = ActiveSheet

ActiveSheet.Name = newnumber
ActiveSheet.Range("I15").Value = newnumber
ActiveSheet.Range("I16") = databook.Sheets("Andhra Pradesh").Range("A9")

MsgBox "Invoices have been created successfully"
ActiveWorkbook.Save

End Sub

---

我有点被你问的问题弄糊涂了，但是下面的一些方法应该行得通。只要根据你的需要调整它

Sub Main()
Dim wkbook As Workbook
Set wkbook = Workbooks.Add

If Len(dir( ***Your Directory Path *****, vbDirectory)) = 0 Then
    MkDir ***Your Directory Path *****
End If

With wkbook
    .Title = "Workbook Title"
    .Subject = "Workbook Subject"
    .SaveAs FileName:= ***Your Directory Path *****\"Workbook Title.xls"
End With

With wkbook.Worksheets("Sheet1")
.Range("I16") = **Your Original Worksheet**.Worksheets("Sheet1").Range("A1").value
'repeat for all values
end with

wkbook.save
wkbook.close
end sub

如果我是你，我会将原始工作簿中的值传递给变量数组，然后用for循环读取它们。如

dim myValues as Variant
dim I as Integer

myValues = Worksheets("Sheet1").Range("A9:G11").Value

for I = LBound(myValues) to Ubound(myvalues)
'do work here (See the with wkbook statement above)
next I

这应该让你开始

dim myValues as Variant
dim I as Integer

myValues = Worksheets("Sheet1").Range("A9:G11").Value

for I = LBound(myValues) to Ubound(myvalues)
'do work here (See the with wkbook statement above)
next I