1つのExcelワークブック内の複数のデータを別のExcelワークブックに転送する方法

Question

更新ボタンのコードを作成してください。私は1つのブックを持っていたかった - データを入力すると、ブックを見て、更新ボタンをクリックすると、自動的に特定のブックが更新され、ブックファイルに基づいて更新されます。 EnterData Workbookに記載されています。

例：私は以下の詳細でEnterDataを作りたいと思う。

ItemNameの： アイテムの数量：

部門：3部門月額 シート名：月 ファイル名：ItemNameの

に依存し、私は更新ボタンをクリックすると、それが自動的に特定を更新します特定のシート名と部門を持つファイル

あなたは私にこれを手伝ってもらえますか？

Answer 1

これはあなたに良いスタートをもたらすでしょう。
私は、実行する作業を単純で読みやすく論理的なタスクに分割しようとします。

• のような設定に使用定数：ルートディレクトリ、セル参照、列参照 私はモジュールの上部の文字列=「Cとして

  公共のConst TartgetWorkBookNameでこれを見てみたい：\ Users \ユーザーSomeFolder \ Data.xlsmシート3 A1 "のコードに埋もれこのどこかに対

"文字列=として 公共のConst TartgetTopLeftCellAddress"」文字列=として 公共のConst TartgetWorkSheetName"：

Dim TargetWorkBook As Workbook 
Set TargetWorkBook = Application.Workbooks.Open("C:\Users\SomeFolder\Data.xlsm") 
Set getTargetR1C1 = TargetWorkBook.Worksheets("Sheet3").Range("A1") 

ここには、私が従う基本パターンの概略図があります。これは実用的な例です。

Option Explicit 

    Const TartgetWorkBookName As String = "C:\Users\SomeFolder\Data.xlsm" 
    Const TartgetWorkSheetName As String = "Sheet3" 
    Const TartgetTopLeftCellAddress As String = "A1" 

    Dim TargetWorkBook As Workbook 
    Set TargetWorkBook = Application.Workbooks.Open(TartgetWorkBookName) 
    Set getTargetR1C1 = TargetWorkBook.Worksheets(TartgetWorkSheetName).Range(TartgetTopLeftCellAddress) 

Sub PostRecord() 
    Dim TargetR1C1 As Range, ItemName As String, Qty As Double, Department As String, Month_ As Integer 
    Set TargetR1C1 = getTargetR1C1() 

    'If your transfering a lot of data turn off 
    Speedboost True 
    '------Begin Loop 
    '------For x = 2 to LastColumn 
    '------Set Variables 
    ItemName = "Dragon Sauce" 
    Qty = 3 
    Department = "Spicy Hot Stuff" 
    Month_ = Month(Date) 

    '------Post Varibles to taget 
    UpdateRecord TargetR1C1, ItemName, Qty, Department, Month_ 

    'Next 
    'Turn Everything back on 
    Speedboost False 
End Sub 

Sub UpdateRecord(TargetR1C1 As Range, ItemName As String, Qty As Double, Department As String, Month_ As Integer) 
    Dim c As Range 
    Dim x As Long, y As Long 
    If Len(TargetR1C1.Offset(1)) Then 
     x = TargetR1C1.End(xlDown).Row + 1 
    Else 
     x = TargetR1C1.Rows + 1 
    End If 
    y = TargetR1C1.Column 

    Set c = TargetR1C1.Cells 
    c(x, y) = ItemName 
    c(x, y + 1) = Qty 
    c(x, y + 2) = Department 
    c(x, y + 3) = Month_ 

End Sub 

Sub Speedboost(bSpeedUpMacros As Boolean) 
    With Application 
     .ScreenUpdating = Not (bSpeedUpMacros) 
     .EnableEvents = Not (bSpeedUpMacros) 
     If bSpeedUpMacros Then 
      .Calculation = xlCalculationManual 
     Else 
      .Calculation = xlCalculationAutomatic 
     End If 
    End With 
End Sub 

Function getTargetR1C1() As Range 
    Dim TargetWorkBook As Workbook 
    Set TargetWorkBook = Application.Workbooks.Open(TartgetWorkBookName) 
    Set getTargetR1C1 = TargetWorkBook.Worksheets(TartgetWorkSheetName).Range(TartgetTopLeftCellAddress) 
End Function