excel - VBA复制数据以根据标准将数据复制到新工作簿

Question

我有 2 个工作簿 - 数据文件(表格:Andhra Pradesh)和发票文件(要在最后一张发票之后添加新发票)。

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

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

订单关闭日期 (A9) 复制到 I16

将 PO 编号 DO666 (B9) 复制到 B31，

订单 ID 1234 (C9) 复制到 A34，

规范名称 - 3 个项目 (E9:E11) 复制到 B34:B36,

发票数量 (F9:F11) 复制到 G34:G36,

发票金额 (G9:G11) 复制到 I34:36

PO 编号 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)

B31
PO Number DO666
A34        B34           G34       I34
Order ID   Spec Name     Qty      Invoice Amt
1234        A            10        $100
            B            20        $200
            C            30        $300

Invoice 301
B31
PO Number: DO667

这是我的代码:

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

Answer 1

我对您所问的一些问题感到困惑，但以下内容应该可行。只需根据您的需要进行调整。

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

那应该让你开始。