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

任何帮助将不胜感激。 我试图完成的是从多个工作簿采取相同的范围，并粘贴到一个单独的工作簿。 我遇到的问题是我想将数据粘贴到下一个可用的行中。 我目前的代码做一切正确，除了粘贴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 

---

编辑

join问题的第二部分。 假设所有的空白行被复制到主目标工作表，所以我们只需要删除那里的空白…请注意，这可能是缓慢的，取决于你有多less行：

 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