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

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

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

Answer 1

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

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