Excel 从多行循环复制将它们分别粘贴到同一行中。。。。

..在单独的工作簿上无限期显示

您好，首先我是新来的，对VBA非常陌生。我有一个工作簿，它有一个名为“book1”的无限增长列表，我拼凑的代码从该书中的某个范围获取数据，并将其粘贴到另一本书“DMAutocalcs”中的特定行中，每次粘贴一行，代码执行刷新和等待时间，然后从中的特定范围复制特定的定价日期“DMautoCalcs“回到第一册。到目前为止，我正在手动复制代码，并针对需要传输的每个呼叫范围对其进行修改。因此，问题就在这里，本质上，它将受到我希望复制现有内容的次数的限制。我打算修改代码，在工作簿之间循环并执行复制粘贴，直到它到达“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

在复制和粘贴之前，无需选择或激活范围或窗口。下面是修改后的代码，我可以理解你

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

---

谢谢你的及时回复，我会试一试。开尔文004，谢谢你，这肯定让我们朝着正确的方向前进。我非常惊讶。但是，一旦它在下一个单元格之前完成了它的操作，值就会重置为零，就好像值没有完全粘贴或存储在单元格中一样。我得到了它，但我必须修改cod的最后一位，如下所示：[code/]wsDm.Range（“T2:X2”）。Copy wsB1.Range（“r2:v2”）。Offset（I-2）。paste特殊xlPasteValues next I[code/]是。根据您的情况进行必要的更改。我猜要复制的范围包含涉及其他范围的公式。谢谢。