具有动态范围的 VBA 复制和粘贴答案

【问题标题】：VBA copy & paste with dynamic range具有动态范围的 VBA 复制和粘贴
【发布时间】：2012-08-21 17:49:50
【问题描述】：

我是 VBA 新手，但我被困在某个地方。我必须将 A 列的最后一行复制到 H 列并将其粘贴到 I 列的最后一行。列的最后一行将始终更改。

例如;我的数据在 A2:H2 中，I5 是最后一个有数据的单元格。
我的代码应该是复制 A2:H2 并粘贴到 A3:H5。第二次运行宏（在我将新数据添加到各个列之后）它应该复制 A6:H6 并将其粘贴到 I 列的最后一行。

我写了两个不能满足我需求的代码。

第一个代码是;

  Sub OrderList1()

    Range("a65536").End(xlUp).Resize(1, 8).Copy _
    (Cells(Cells(Rows.Count, 9).End(xlUp).Row, 1))

  End Sub

此代码跳过 A3:H4 并仅粘贴到 A5:H5

第二个代码是;

 Sub OrderList2()
   Range("A2:H2").Copy Range(Cells(2, 8), _
   Cells(Cells(Rows.Count, 9).End(xlUp).Row, 1))

 End Sub

它复制 A2:H3 并将其粘贴到 A5:H5 但是当我添加新数据时它不会从 A5:H5 开始粘贴。它从 A2:H2 开始并覆盖旧数据。我可以看到我必须更改的内容，范围应该是第一个代码中的动态范围，但我无法编写代码。

非常感谢您的帮助。

【问题讨论】：

标签： vba dynamic excel range

【解决方案1】：

您可能想以此为起点：

Dim columnI As Range
Set columnI = Range("I:I")

Dim columnA As Range
Set columnA = Range("A:A")

' find first row for which cell in column A is empty
Dim c As Range
Dim i As Long
i = 1
For Each c In columnA.Cells
    If c.Value2 = "" Then Exit For
    i = i + 1
Next c

' ok, we've found it, now we can refer to range from columns A to H of the previous row
' to a variable (in the previous row, column A has not been empty, so it's the row we want
' to copy)
Dim lastNonEmptyRow As Range
Set lastNonEmptyRow = Range(Cells(i - 1, 1), Cells(i - 1, 8))

' and now copy this range to all further lines, as long as columnI is not empty
Do While columnI(i) <> ""
   lastNonEmptyRow.Copy Range(Cells(i, 1), Cells(i, 8))
   i = i + 1
Loop

【讨论】：

如果您在代码中添加一些 cmets，您的答案肯定会更好（如果您觉得很明显，这可能会对其他用户有所帮助）
是的。我不会遵循相同的模型，但它可能有效。
您好 JohnB，首先感谢您的努力。当我运行此代码时，它工作正常，但是当我将它放入我的代码中时，它给出了错误的结果。而不是复制和粘贴最后一行直到第 I 列。它复制最后一行并将其粘贴到 A2:H2 并将 A2:H2 的旧数据复制到最后一行直到第 I 列。
可能与代码认为“空”的内容有关。首先，您可以将 c.Value2 和 columnI(i)"" 替换为 c.Text 和 columnI(i).Text ""。此外，您可能还需要查看 B ... H 列的非空性，而不是只考虑 A 列。
您好，我找到了原因。这是我的错误，我在代码中犯了一些错误。我修复了它，现在你的代码工作正常。再次感谢您的帮助。

【解决方案2】：

试试这个，以获得未来的功能，或者至少它对我有用...询问您是否需要帮助理解它:)

Option Explicit

Sub lastrow()
    Dim wsS1 As Worksheet 'Sheet1
    Dim lastrow As Long
    Dim lastrow2 As Long

    Set wsS1 = Sheets("Sheet1")

    With wsS1

'Last row in A
        lastrow = Range("A" & Rows.Count).End(xlUp).Row

'Last Row in I
        lastrow2 = Range("I" & Rows.Count).End(xlUp).Row

'Cut in A:H and paste into last row on I
        wsS1.Range("A2:H" & lastrow).Cut wsS1.Range("I" & lastrow2)
    End With

End Sub

【讨论】：