Excel 将非连续数组值复制到其他工作簿

我尝试使用命名范围、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\u Database.xlsx”）
带工作表（“客户数据”）

我的源工作簿是

C:\bm\invoice\MasterInvoice1.xlsx

---

在复制/粘贴之后，我需要保存并关闭目标工作簿。

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

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_数据库。我想你是在做出口，但应该很容易转换

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

---

以下是不使用（未测试）打开源工作簿的替代方法

---

出于兴趣：您发现Excel中不再存在哪些函数？什么是

工作表（“发票”）

？此

工作表属于哪个
工作簿
？Excel如何猜测到哪一个？你的床单没有完全合格。请尝试
工作簿（“您的工作簿名称”）。工作表（“您的工作表名称”）。范围
我可以为您的代码提供一些升级吗？我会把它们添加到你答案的底部，看起来更好！谢天谢地，我显然没有说清楚，或者我只是知道的不够多，无法让这一切顺利进行。打开的文件（在中工作）和源是C:\bm\invoice\MasterInvoice1.xlsx，工作表发票，目标关闭的文件是同一文件夹中的Customer\u Database.xlsx，工作表CustomerData。我需要复制许多分散在电子表格上的单个单元格（数组），如第一篇文章所示。所以我需要复制数组，打开目标，粘贴到下一个可用的行中。我又看了一遍，数组的大小是否每次都会改变，或者要复制的单元格是否总是完全相同？
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