VBA复制数据以根据标准将数据复制到新工作簿答案

【问题标题】：VBA copy data to Copy Data To New Workbook Based On CriteriaVBA复制数据以根据标准将数据复制到新工作簿
【发布时间】：2011-11-24 05:59:54
【问题描述】：

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

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

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

将订单关闭日期 (A9) 复制到 I16
PO 编号 DO666 (B9) 复制到 B31，
将订单 ID 1234 (C9) 复制到 A34，
规范名称 - 3 个项目 (E9:E11) 被复制到 B34:B36，
发票数量(F9:F11)复制到G34:G36，
要复制到 I34:36 的发票金额 (G9:G11)
应将 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

【问题讨论】：

标签： excel vba

【解决方案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

这应该让你开始。

【讨论】：