從多個工作簿復制並粘貼到單個工作簿中，再到下一個空白行

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

---

編輯

在問題的第二部分中添加。 假設所有空白行都已復制到主目標表，那么我們只需要刪除那里的空白...請注意，這可能很慢，具體取決於您獲得的行數：

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