同じ行に複数の行を個別に貼り付けるループコピー....

Question

.....別のワークブックに無期限に。

こんにちは、私はここでは新しい、そしてVBAにとってはとても新しいです。私は無限に "book1"という名前で成長するリストを持つワークブックを持っています。コードは、その本の範囲からデータを集めて、それを別のブック "DMAutocalcs"に一度に1つの特定の行にペーストします。コードはリフレッシュと待機時間を実行した後、特定の価格設定日付を "DMautoCalcs"の特定の範囲からBook1にコピーします。現時点では、私は手動でコードをコピーして、転送する必要のあるコールの各範囲に対して変更しています。それで問題は、本質的には私が存在するものをコピーしたい回数によって制限されます。私はコードをループし、 "book1"の空のセルに到達するまでブック内でコピー貼りを実行するつもりですが、私が試したすべての試行は失敗しました。手動でコピーしない限り、新しい行ごとにコードを作成して変更します。私は、親戚や絶対的なものについては範囲の行とセルの側面を完全に理解していないし、正しい方法を正確に呼び出す方法については理解していないのではないかと心配しています。 これはどのように達成するのですか？どんな助けもありがとう。

Public Sub macro_54() 
' Keyboard Shortcut: Ctrl+p 
Dim StartTime As Double 
Dim SecondsElapsed As Double 

StartTime = Timer 

Workbooks.Open ("C:\Users\Legacy\Desktop\DMAutoCalcs.xlsm") 

Windows("Book1.xlsm").Activate 
Range("a2:l2").Select 
Selection.Copy 
Windows("DMAutoCalcs.xlsm").Activate 
Range("a1:q1").Select 
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ 
         :=False, Transpose:=False 
'Refresh 
ActiveWorkbook.RefreshAll 
Application.Wait (Now + TimeValue("0:00:03")) 
ActiveWorkbook.RefreshAll 

Windows("DMAutoCalcs.xlsm").Activate 
Range("T2:x2").Select 
'Application.CutCopyMode = False 
Selection.Copy 
Windows("Book1.xlsm").Activate 
Range("M2:q2").Select 
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ 
         :=False, Transpose:=False 
' copy from calcs pricing info and past into pricelist 
' return to pricelist 
' Selects cell down 1 row from active cell. 
'New Line 
Windows("Book1.xlsm").Activate 
Range("a3:l3").Select 
Selection.Copy 
Windows("DMAutoCalcs.xlsm").Activate 
Range("a1:q1").Select 
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ 
         :=False, Transpose:=False 
' Refresh 

ActiveWorkbook.RefreshAll 
Application.Wait (Now + TimeValue("0:00:03")) 
ActiveWorkbook.RefreshAll 

Windows("DMAutoCalcs.xlsm").Activate 
Range("T2:x2").Select 
'Application.CutCopyMode = False 
Selection.Copy 
Windows("Book1.xlsm").Activate 
Range("M3:q3").Select 
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ 
         :=False, Transpose:=False 

' copy from calcs pricing info and past into pricelist 
' return to pricelist 
' Selects cell down 1 row from active cell. 

'New Line 
Windows("Book1.xlsm").Activate 
Range("a4:l4").Select 
Selection.Copy 
Windows("DMAutoCalcs.xlsm").Activate 
Range("a1:q1").Select 
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ 
         :=False, Transpose:=False 
' Refresh 
ActiveWorkbook.RefreshAll 

Application.Wait (Now + TimeValue("0:00:03")) 

ActiveWorkbook.RefreshAll 

Windows("DMAutoCalcs.xlsm").Activate 
Range("T2:x2").Select 
'Application.CutCopyMode = False 
Selection.Copy 
Windows("Book1.xlsm").Activate 
Range("M4:q4").Select 
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ 
         :=False, Transpose:=False 

' copy from calcs pricing info and past into pricelist 
' return to pricelist 
' 
' Selects cell down 1 row from active cell. 
' And so on and so forth.... 
Windows("DMAutoCalcs.xlsm").Activate 
ActiveWorkbook.Close savechanges:=False 
Windows("Book1.xlsm").Activate 
'Determine how many seconds code took to run 
SecondsElapsed = Round(Timer - StartTime, 2) 
'Notify user in seconds 
MsgBox "All Ranges Updated, Calc sheet closed successfully in " & SecondsElapsed & " seconds", vbInformation 

End Subの

Answer 1

あなたはコピー＆ペーストする前に範囲またはウィンドウを選択したり、アクティブにする必要はありません。以下は私が理解できる変更されたコードです。

Sub macro_54_Modified() 
'Let your working sheets in Book1 and DMAutoCalcs are Sheet1 and Sheet2, respectively 

    Workbooks.Open "C:\Users\Legacy\Desktop\DMAutoCalcs.xlsm" 

    Dim wsDm As Worksheet, wsB1 As Worksheet, lastRow As Long, i As Long 
    Set wsB1 = Workbooks("Book1.xlsm").Sheets("Sheet1") 
    Set wsDm = Workbooks("DMAutoCalcs.xlsm").Sheets("Sheet2") 

    'Last row number in column A 
    lastRow = wsB1.Cells(Rows.Count, 1).End(xlUp).Row 

    For i = 2 To lastRow 
     wsB1.Range("A2:L2").Offset(i - 2).Copy wsDm.Range("a1:q1") 
     'VBA code for Refresh ... ? 
     wsDm.Range("T2:X2").Copy wsB1.Range("M2:q2").Offset(i - 2) 
    Next i 
End Sub