Объединине файлов в один с определнной строки - VBA

Sub Сращение()
Dim oFSO As Object
Dim oFolder As Object
Dim oFile As Object
Dim sFolderName, sName, sFullName, sFileName As String
Dim oWB As Workbook
Set oWB = ActiveWorkbook
sName = oWB.Name
sFullName = oWB.FullName
sFolderName = Replace(sFullName, sName, "")
Set oFSO = CreateObject("Scripting.FileSystemObject")
Set oFolder = oFSO.GetFolder(sFolderName)
    For Each oFile In oFolder.Files
    sFileName = oFile.Name
        If Not sFileName = sName And Not InStr(sFileName, "$") >= 1 And InStr(sFileName, "xls") >= 1 Then
            Call ApplicationOne(sFileName, sFolderName)
        End If
    Next oFile
oWB.Close SaveChanges:=wbSaveChanges
End Sub
Private Sub ApplicationOne(ByVal sFileName As String, ByVal sFolderName As String)
Dim oWB As Workbook
Dim oWBN As Workbook
Dim oList As Worksheet
Dim oListNew As Worksheet
Set oWB = ActiveWorkbook
Set oList = oWB.Sheets("Лист1") 'это имя листа
Set oWBNew = Workbooks.Open(Filename:=sFolderName & sFileName)
Set oListNew = oWBNew.Sheets("Лист1") 'Это имя листа открытой книги
oList.Activate
Dim lRange As Long
    lRange = LastRowFind(oList)
    lRange = lRange + 1
    oListNew.Activate
Dim lRangeNew As Long
Dim iFirstNew As Integer
Dim sText As String
    sText = "Столбец1" 'Это заголовок столбца
    iFirstNew = Columns("A:A").Find(What:=sText).Row
    lRangeNew = LastRowFind(oListNew)
Range("A" & iFirstNew & ":" & "G" & lRangeNew).Select
Selection.Copy
oList.Activate
oList.Rows(lRange).PasteSpecial
'oWBNew.Close SaveChanges:=wdDoNotSaveChanges
End Sub
Private Function LastRowFind(ByVal wList As Worksheet)
Dim lRange As Long
Dim iFirst As Integer
lRange = Range("A" & Rows.Count).End(xlUp).Row
lRange = lRange - Not IsEmpty(Range("A" & lRange))
LastRowFind = lRange - 1
End Function