在列标题下插入新find的行

嗨,目前我有一个代码,可以帮助我复制和粘贴信息在外部工作簿基于匹配的条件,如“新加坡”新find的行。 代码将查看外部工作簿中的工作表,并search列中具有“新加坡”的所有行,并将其粘贴到另一个工作簿中。 但我现在面临的问题是,正在复制和粘贴的行与我的列标题重叠,而不是插入到工作表的最后一行。 以下是来自外部工作簿的信息将被粘贴到的图像。 在这里输入图像说明

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

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 

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

您可能需要添加该行

 lRow = lRow + 1 

之后的部分

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