Question

我尝试使用命名范围来解决这个问题，for和do循环，找到Excel中不再存在的函数。

我使用发票并希望将每个新发票中的客户联系人数据，他们购买的商品，支付的价格，评论等保存到单个单独的工作簿中 - 在每个新发票/客户的下一个空行中

我成功完成了这项工作，只是复制到同一工作簿中的另一个工作表，但无法将其放入另一个工作簿中，因此我可以拥有一个单独的客户和销售数据文件。

我将在当前发票文件中工作，该文件是从包含宏的模板（MasterInvoice.xltm）中作为新工作簿打开的。发票完成后，使用按钮按顺序复制特定单元格的数组，这些顺序将在下一个空行的数据存储工作簿中以不同的顺序放置它们。

复制的数据应按所列顺序粘贴到一行中。下面的代码在同一个工作簿中工作，但我无法创建适用于工作簿的东西：

Sub CopyCustomerData()

Dim LR As Long, i As Long, cls

cls = Array("F5", "A11", "F6", "F7", "F11", "F13", "A12", 
"A13", "A14", "D11", "D12", "D13", "D14", "C15", "F42", "F20", "A39")
With Sheets("Customers")
    LR = WorksheetFunction.Max(2, .Range("A" & Rows.Count).End(xlUp).Row + 1)
    For i = LBound(cls) To UBound(cls)
        .Cells(LR, i + 1).Value = Sheets("Invoice").Range(cls(i)).Value
    Next i
End With

End Sub

我的目标是Workbooks.Open ("C:\bm\invoice\Customer_Database.xlsx") With Sheets("CustomerData")

我的源工作簿是C:\bm\invoice\MasterInvoice1.xlsx

复制/粘贴后，我需要保存＆amp;关闭目标工作簿。

Answer 1

为了跟上工作中的关键绩效指标，我做了类似的工作。我知道还有其他方法可以做到，但这是我发现的工作方式。由于工作簿位于同一文件夹中，因此您可以从当前工作簿中获取目录路径，并使用反斜杠和工作簿名称进行连接。我会注释掉保存工作簿行，直到您有正确的方式粘贴信息。

Dim wb as string
Dim ap as string

ap = ActiveWorkbook.Path 'Since they are in the same folder
wb = ap & "\Customer_Database.xlsx"


'select you range and copy it like you have done ex. 
Sheets("Sheet1").Range("Your Range Here").Copy

Workbooks.Open(wb)
Workbooks("Customer_Database.xlsx").Sheets("Sheet_Name").Activate
    Sheets("Sheet Name").Range("Cell to paste date in").Paste
Workbooks("Customer_Database.xlsx").Close SaveChanges:=True

Edit1 ：使用变量定义您打开的新工作簿。之后，无需使用Activate进行粘贴。

Dim DestWb  As Workbook
Dim WbName As String
Dim ap As String

ap = ActiveWorkbook.Path 'Since they are in the same folder
WbName = ap & "\Customer_Database.xlsx"

' set the opened workbook to a workbook object
Set DestWb = Workbooks.Open(WbName)

'select your range and copy it like you have done ex.
ThisWorkbook.Sheets("Sheet1").Range("Your Range Here").Copy

With DestWb
    'directly paste
    .Sheets("Sheet Name").Range("Cell to paste date in").Paste
    .Close (True)
End With

编辑：我经历并使用了您现有的工作，并使用两个具有相同名称的工作表，并将数据从MasterInvoice1工作簿导入到Customer_Database。我认为你正在进行导出，但它应该很容易切换。

Sub CopyCustomerData()
'I ran this macro from the Customer_Database workbook and saved it as a macro enabled
'workbook. I think it should be saved in the workbook that you are going to be building
'and maintaining yourself. You can flip a few things around and get it to work from the
'MasterInvoice1 workbook if you would rather.

Dim LR As Long, i As Long
Dim cls As Variant
Dim AP As String
Dim wbArray(1 To 4) As String

AP = ThisWorkbook.Path

'In my opion this will make it easier to open workbooks and to activate the workbooks.
wbArray(1) = AP & "\Customer_Database.xlsm"
wbArray(2) = AP & "\MasterInvoice1.xlsx"
wbArray(3) = "Customer_Database.xlsx"
wbArray(4) = "MasterInvoice1.xlsx"

cls = Array("F5", "A11", "F6", "F7", "F11", "F13", "A12", _
"A13", "A14", "D11", "D12", "D13", "D14", "C15", "F42", "F20", "A39")

'Opens the workbook MasterInvoice1.xlsx, this format needs the full path.
Workbooks.Open (wbArray(2))
With ThisWorkbook.Sheets("Customers")
    LR = WorksheetFunction.Max(2, .Range("A" & Rows.Count).End(xlUp).Row + 1)
    For i = LBound(cls) To UBound(cls)
        'Make sure that when you are refering to a sheet in another workbook
        'have Workbooks(otherWB) before it, or it will think you are looking for
        'that sheet in the same workbook.
        'Also this pastes the values in the next column starting on row 2.
        .Cells(LR, i + 1).Value = Workbooks(wbArray(4)).Sheets("Invoice").Range(cls(i)).Value
    Next i
End With
'This will close the MasterInvoice1.xlsx workbook.
Workbooks(wbArray(4)).Close SaveChanges:=True
End Sub

Answer 2

如果不使用external references（未测试）

打开源工作簿，则可以使用此选项

Sub CopyCustomerData()
    Dim w As Workbook, r As Range, s as String, a() As String

    s = " F5 A11 F6 F7 F11 F13 A12 A13 A14 D11 D12 D13 D14 C15 F42 F20 A39"
    a = Split(Trim(Replace(s, " ", " ='C:\bm\invoice\[MasterInvoice1.xlsx]Invoice'!")))

    Set w = Workbooks.Open("C:\bm\invoice\Customer_Database.xlsx")
    Set r = w.Worksheets("CustomerData").UsedRange

    Set r = r.Offset(r.Rows.Count).Resize(1, UBound(a) + 1)    ' last empty row
    r.Formula = a
    r.Value2 = r.Value2     ' optional to convert the formulas to values

    w.Close SaveChanges:=True
End Sub

将非连续数组值复制到另一个工作簿

2 个答案: