macros插入新行并复制一个值覆盖下面的行

我写了一个macros，它search包含文本“AddCompany”的单元格的列，然后为每个这样的单元格插入一个新行到不同的表单中，然后复制并粘贴相邻单元格的值（其中包含名称的一家公司）进入新的一排。

在我的副本中，我正在使用“testing公司1”中的“testing公司4”的单元格组成名称来testingmacros。 macros正确插入4个新行，但只有最后一家公司，“testing公司4”被粘贴。 它被粘贴到错误的单元格中，在新插入的行正下方的行中。

最后的结果是，macros插入第9行到第12行，并将“Test Company 4”粘贴到已经包含名称（我不希望改变）的行13中。

我想让macros做的是为每个find的“AddCompany”插入一个“新”行（恰好是这个例子中的第9行），然后把公司名称粘贴到相邻的单元格中，并重复，直到完成。 新插入的9到12行应该最后显示每个testing公司。

任何帮助都感激不尽。

谢谢你，乔恩

Sub AddMoreCompanies() Dim Table As Worksheet: Set Table = Worksheets(1) Dim Notes As Worksheet: Set Notes = Worksheets(2) Dim Accounts As Worksheet: Set Accounts = Worksheets(3) Dim SandI As Worksheet: Set SandI = Worksheets(4) Dim Report As Worksheet: Set Report = Worksheets(5) Dim Entry As Worksheet: Set Entry = Worksheets(6) Dim Issuer As Worksheet: Set Issuer = Worksheets(7) Dim Col As Range: Set Col = Entry.Range("L5:L250") Dim tCell As Range Dim Target As Range: Set Target = Table.Range("D9") For Each tCell In Col If tCell.Value = "AddCompany" Then 'Inserts new row in the Table Table.Rows("9:9").Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove Table.Rows("10:10").Copy Table.Rows("9:9").PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _ SkipBlanks:=False, Transpose:=False Application.CutCopyMode = False Table.Range("E10:I10").AutoFill Destination:=Range("E9:I10"), Type:=xlFillDefault 'copies text into target cell Else End If If tCell.Value = "AddCompany" Then Target.Value = tCell.Offset(0, 1).Value Else End If Next tCell 'Target.Value = tCell.Offset(0, 1).Value End Sub 

Answer 1

你所缺less的是， Targetvariables定义为Set Target = Table.Range("D9")将向下移动，变成D10 ，然后D11 （直到D13 ），每次在它上面Insert一个新行。

要快速修复 ，请在复制该值之前尝试重新定义它 。 通过改变

 Target.Value = tCell.Offset(0, 1).Value 

成

 Table.Range("D9").Value = tCell.Offset(0, 1).Value