複製的非連續的數組值到另一個工作簿

Question

我試圖解決這個使用命名範圍，對於和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

我沒有在工作，關鍵績效指標保持了類似的東西。我知道還有其他方法可以做到，但這是我發現的工作。由於工作簿位於同一個文件夾中，因此可以從當前工作簿獲取目錄路徑，並使用反斜槓和工作簿名稱進行連接。我將註釋掉保存工作簿行，直到您有正確的方式來粘貼信息。

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