vba 循环插入行，复制数据

Loop to Insert Row, Copy data

提问by Ken Ingram

I give up. I just spent four hours trying to figure out why this macro will not work. I want it to take the given source Range, cycle through it using the ForLoop and copy the Value to a different column.

我放弃。我只是花了四个小时试图弄清楚为什么这个宏不起作用。我希望它采用给定的源范围，使用循环遍历它For并将值复制到不同的列。

I want it to start at the given destination cell and

我希望它从给定的目标单元格开始

• enter the value
• create a new row using Insert (entire row, not just insert into that column. I want to fit the data within an existing set of rows)
• Not override the Marker that designates the end point of the destination column. There is data below it which needs to be kept.

• 输入值
• 使用 Insert 创建一个新行（整行，而不仅仅是插入到该列中。我想将数据放入现有的一组行中）
• 不覆盖指定目标列终点的标记。它下面有需要保留的数据。

I can't figure out why

我不明白为什么

• In one instance of procedure, it enters the value but then wipes out the data as it inserts the next row.
• In the second instance, it skips a row and obliterates the end of column marker

• 在过程的一个实例中，它输入值，然后在插入下一行时擦除数据。
• 在第二种情况下，它跳过一行并删除列标记的末尾

Note that I'm not looking for clever, elegant solutions to the problem, in an effort to teach myself the vbaparadigm, I want to keep things really basic. As I get better at understanding the basics, I'll try some advanced tricks.

请注意，我不是在寻找聪明、优雅的问题解决方案，为了自学vba范式，我想让事情变得非常基本。随着我对基础知识的理解越来越好，我会尝试一些高级技巧。

TIA

TIA

Sub Macro1()
Dim firstRow As Range, lastRow As Range
Dim source As Range, destination As Range
Dim readCell As Range

Set firstRow = Range("F2")
Set lastRow = Range("F20")
Set destination = Range("A21")


Set source = Range(firstRow.Address(False, False) & ":" & lastRow.Address(False, False))

For Each readCell In source
    destination.Select
    destination.Value = readCell.Value

    If (readCell.Address(False, False) = lastRow.Offset(1, 0)) Then
        Exit For
    Else
       'destination.Select
    End If

    'MsgBox (destination.Value)
    destination.EntireRow.Insert Shift:=xlUp
    Set destination = destination.Offset(1, 0)
Next
End Sub

采纳答案by chris neilsen

Here's some hints:

这里有一些提示：

Given that firstRowand lastRoware single cells, no need for the Addressstuff. Use

由于firstRow和lastRow是单细胞，不需要的Address东西。用

Set source = Range(firstRow,  lastRow)

In destination.EntireRow.Insert Shift:=xlUp, because you are applying Insertto an entire row, Shiftmakes no difference. Use

在 中destination.EntireRow.Insert Shift:=xlUp，因为您正在申请Insert整行，所以Shift没有区别。用

destination.EntireRow.Insert

The inserted row in placed above destination, and destinationis shifted down. So the first iteration of the for loop does this

插入的行放置在 上方destination，并向destination下移动。所以 for 循环的第一次迭代就是这样做的

1. Set destinationto A21
2. Insert row, shifting destinationto A22
3. Set desinationdown one row, ie A23

1. 设置destination为A21
2. 插入行，destination移至A22
3. 设置desination下移一行，即A23

The next iteration will then overwrite the data originally in A22, now in A23

下一次迭代将覆盖原来在 中的数据A22，现在在A23

I think you want

我想你想要

Sub Macro1()
    Dim firstRow As Range, lastRow As Range
    Dim destination As Range
    Dim readCell As Range

    Set firstRow = Range("F2")
    Set lastRow = Range("F20")
    Set destination = Range("A21")

    For Each readCell In Range(firstRow, lastRow)
        destination.Value = readCell.Value
        destination.EntireRow.Offset(1, 0).Insert
        Set destination = destination.Offset(1, 0)
    Next
End Sub

回答by brettdj

Very commendable that you want to understand as well as solve

很赞，想了解也想解决

It is easier to use a row counter than increments from a fixed destination. This minor adjustment

使用行计数器比从固定目的地增加更容易。这个小调整

• avoids Select

• uses a counter, lngRow, to control the new row and new values

  code

  Sub Macro1()
  Dim readCell As Range
  Dim lngRow As Long
  For Each readCell In Range("F2:F20")
      [a21].Offset(lngRow, 0).EntireRow.Insert Shift:=xlUp
      [a21].Offset(lngRow, 0).Value = readCell.Value
      lngRow = lngRow + 1
  Next
  End Sub
  

• 避免 Select

• 使用计数器 ,lngRow来控制新行和新值

  code

  Sub Macro1()
  Dim readCell As Range
  Dim lngRow As Long
  For Each readCell In Range("F2:F20")
      [a21].Offset(lngRow, 0).EntireRow.Insert Shift:=xlUp
      [a21].Offset(lngRow, 0).Value = readCell.Value
      lngRow = lngRow + 1
  Next
  End Sub