在列标题下方插入新找到的行

时间:2015-10-09 07:18:56

标签: excel vba excel-vba

您好我目前有一个代码可以帮助我根据匹配条件(例如“新加坡”)从外部工作簿中复制和粘贴新找到的行。代码将查看外部工作簿中的工作表,并搜索列中包含“Singapore”的所有行,并将其粘贴到另一个工作簿。但我现在面临的问题是,正在复制和粘贴的行与我的列标题重叠,而不是插入到工作表的最后一行。 下面是将外部工作簿中的信息粘贴到的图像。 enter image description here

但是,当我运行如下代码时:

Sub UpdateNewUpcomingProj()

    Dim wb1 As Workbook, wb2 As Workbook
    Dim ws1 As Worksheet, ws2 As Worksheet
    Dim copyFrom As Range
    Dim lRow As Long '<~~ Not Integer. Might give you error in higher versions of excel
    Dim strSearch As String

    Set wb1 = Application.Workbooks.Open("U:\Active Master Project.xlsm")
    Set ws1 = wb1.Worksheets("New Upcoming Projects")

    strSearch = "Singapore"

    With ws1

        '~~> Remove any filters
        .AutoFilterMode = False

        '~~> I am assuming that the names are in Col A
        '~~> if not then change A below to whatever column letter
        lRow = .Range("A" & .Rows.Count).End(xlUp).Row

        With .Range("A1:A" & lRow)

            .AutoFilter Field:=1, Criteria1:="=*" & strSearch & "*"

            Set copyFrom = .Offset(1, 0).SpecialCells(xlCellTypeVisible).EntireRow

        End With

        .AutoFilterMode = False

    End With

    '~~> Destination File
    Set wb2 = ThisWorkbook
    Set ws2 = wb2.Worksheets("New Upcoming Projects")

     With ws2

        If Application.WorksheetFunction.CountA(.Cells) <> 0 Then

            lRow = .Cells.Find(What:="*", _
                          After:=.Range("A2"), _
                          Lookat:=xlPart, _
                          LookIn:=xlFormulas, _
                          SearchOrder:=xlByRows, _
                          SearchDirection:=xlPrevious, _
                          MatchCase:=False).Row
        Else
            lRow = 2

        End If

     copyFrom.Copy
    .Rows(lRow).PasteSpecial xlPasteAllExceptBorders, xlPasteSpecialOperationNone, False, False
    .Rows.RemoveDuplicates Array(2), xlNo

    End With

End Sub

它给出了这个结果: enter image description here 似乎信息与列标题重叠,而不是将其粘贴到列标题本身下方。我希望任何人都可以帮助我解决在列标题而不是空行上粘贴行的问题。任何帮助,将不胜感激。谢谢。

1 个答案:

答案 0 :(得分:1)

您可能需要添加

lRow = lRow + 1 

之后的

    lRow = .Cells.Find(What:="*", _
                  After:=.Range("A2"), _
                  Lookat:=xlPart, _
                  LookIn:=xlFormulas, _
                  SearchOrder:=xlByRows, _
                  SearchDirection:=xlPrevious, _
                  MatchCase:=False).Row