从多个工作簿复制并粘贴到单个工作簿中，进入下一个空白行

Question

非常感谢任何帮助。我想要实现的是从多个工作簿中获取相同的范围并粘贴到单独的工作簿中。我遇到的问题是我希望将数据粘贴到下一个可用行中。除了粘贴vba（数据当前重叠）

之外，我当前的代码正确地完成了所有操作

我正在复制的范围也有空白行，所以让粘贴代码删除空白行的方法会很棒。

任何帮助都会很棒！

提前谢谢

Sub MergeYear()

Dim bookList As Workbook
Dim mergeObj As Object, dirObj As Object, filesObj As Object, everyObj As 
Object
Dim r As Long
Dim path As String

path = ThisWorkbook.Sheets(1).Range("B9")

Set mergeObj = CreateObject("Scripting.FileSystemObject")
Set dirObj = mergeObj.Getfolder(path)
Set filesObj = dirObj.Files

For Each everyObj In filesObj
Set bookList = Workbooks.Open(everyObj)
r = r + 1
bookList.Sheets(5).Range("A2:Q366").Copy ThisWorkbook.Sheets(5).Cells(r + 1, 
1)
bookList.Close
Next everyObj

End Sub

Answer 1

您需要定义最后一行，然后粘贴到最后一行+ 1。

With ThisWorkbook.Sheets(5) 
    r = .Cells(.Rows.Count, 1).End(xlUp).Row
    bookList.Sheets(5).Range("A2:Q366").Copy .Cells(r + 1, 1)
End With

修改

在问题的第二部分添加。假设所有空白行都被复制到主目标表中，所以我们只需删除那里的空白...请注意，这可能很慢，具体取决于您获得了多少行：< / p>

Dim j as Long, LR as Long
With ThisWorkbook.Sheets(5)
    LR = .Cells(.Rows.Count, 1).End(xlUp).Row 'Assumes col A is contiguous
    For j = LR to 1 Step -1 'VERY IMPORTANT WHEN DELETING
        If .Cells(j, "A").Value = "" Then 'Assumes A must contain values
            .Rows(i).Delete
        End If
    Next j
End With