Vba 插入新行并复制值的宏将覆盖下面的行

我编写了一个宏，它在一列中搜索包含文本“AddCompany”的单元格，然后在每个单元格中插入新行到不同的工作表中，然后将相邻单元格（包含公司名称）的值复制并粘贴到新行中

在我的副本中，我使用单元格中虚构的名称“测试公司1”到“测试公司4”来测试宏。宏正确插入4个新行，但仅粘贴最后一个公司“Test company 4”。它被粘贴到错误的单元格中，在新插入行的正下方的行中

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

我希望宏为找到的每个“AddCompany”插入一个“new”行（在本例中恰好是第9行，以适合较大的表），然后将公司名称粘贴到相邻单元格中，并重复，直到完成。新插入的第9至12行应在末尾显示每个测试公司

任何帮助都将不胜感激

谢谢， 乔恩

---

您缺少的是定义为

Set Target=Table.Range（“D9”）

的

Target

变量将向下移动并变为

D10

，然后每次

在其上方插入新行时
D11
（直到
D13
）

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

进入

您是否尝试过插入复制的行，而不是粘贴？如果需要，您可以多次插入activerow上方的行。嗨，Cyril，目的不是复制整行，而是插入新行，复制格式和一些公式（这部分工作正常）。我的问题是从与包含“AddCompany”的单元格相邻的一个单元格复制值并将该值粘贴到单元格D9中。A.H.S刚才给了我一个适用于这个特定宏的答案，但我很想听听你的评论是什么意思。我可能对你的问题有误解，但我不太明白你的意思。ThanksI认为您应该复制包含“AddCompany”文本的行，然后将其插入activerow下面的行3次。然后，您可以.formula=”“将公司1-4测试到这4行中的每一行（总共4行…原始+3行），完全替换“添加公司”单元格，这样如果循环再次运行，它就不会被拾取。幸运的是，ASH能够解决这个问题，所以不管我的评论是否有意义，你至少得到了~*谢谢你的回答和解释，这就成功了。我现在可以简单地删除对
Target
变量的任何引用，因为这将不再需要。这是你第二次来救我，再次感谢。@Jon0311这是我的荣幸：）
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

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

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