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

Question

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

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

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

我想要宏做的是为它找到的每个“AddCompany”插入一个“新”行（在这种情况下恰好是第 9 行以适合更大的表），然后将公司名称粘贴到相邻的单元格，并重复直到完成。新插入的第 9 行到第 12 行应该最后显示每个测试公司。

任何帮助将不胜感激。

谢谢， 乔恩

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

您缺少的是Target 变量，定义为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