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

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

---

编辑

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

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