Question

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

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

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

我想要宏做的是为它找到的每个“AddCompany”插入一个“new”行（恰好是这个案例中的第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

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

1 个答案: