他のワークブックに不連続な配列値をコピーする

Question

forループとdoループを使用して名前付き範囲を使用してこれを解決しようとしましたが、Excelに存在しない関数が見つかりました。

私は請求書を使用して、顧客の連絡先データ、購入したもの、支払った価格、コメントなどを新しい請求書ごとに1つの個別のワークブックに保存したい - 新しい請求書/顧客。

私はこれを、同じブックの別のシートにコピーするだけで成功しましたが、異なるワークブックに入れることができないため、顧客データと販売データの別々のファイルを持つことができます。

テンプレート（MasterInvoice.xltm）からマクロを使用して新しいワークブックとして開く現在の請求書ファイルで作業します。請求書が完了したら、ボタンを使用して、特定のセルの配列を次の空の行のデータストアブックに異なる順序で配置する順序でコピーします。

コピーしたデータは、リストされている順序で1行に貼り付けられます。 以下のコードと同じワークブック内に動作しますが、私は、ワークブック全体に働く何かを作ることができなかった：

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の仕事についていくのに似たようなことをしました。私はそれを行うための他の方法があることを知っていますが、これは私が働くことがわかったものです。ワークブックは同じフォルダにあるので、現在のワークブックからディレクトリパスを取得し、バックスラッシュとワークブック名​​を連結することができます。私は情報を貼り付ける正しい方法があるまで、ブックの保存行をコメントアウトします。

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 

編集：私は通過した、既存の作品を使用し、同じ名前の2つのワークシートで動作するようにこれを持って、それがCustomer_DatabaseにMasterInvoice1ワークブックからデータをインポートしました。私はあなたが輸出をしていたと思いますが、それは簡単に切り替えるべきです。ここで

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