Vba 将多个工作簿复制并粘贴到单个工作簿的下一个空行中

任何帮助都将不胜感激。我试图实现的是从多个工作簿中获取相同的范围，并粘贴到一个单独的工作簿中。我遇到的问题是，我希望将数据粘贴到下一个可用行中。除了粘贴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

---

您需要定义最后一行，然后粘贴到最后一行+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

---

您需要定义最后一行，然后粘贴到最后一行+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

---

可能的重复可能的重复使用您现有的r，因为它的作品伟大！帮助我如何删除空白行粘贴时？我处理的每个范围都有空行。是否存在公式或只是硬编码的值？可能希望使用bookList.Sheets（5）.Range（“A2:Q366”）.SpecialCells（xlCellTypeConstants）假设用于查找空行的条件列可以是A并且包含常量（即非公式），请使用

Application.Intersect（bookList.Sheets（5）.Range（“A2:A366”）.SpecialCells（XlCellType.xlCellTypeConstants）.EntireRow，bookList.Sheets（5）.Range（“A2:Q366”））.复制…

。这里的原理是，SpecialCells将在criteria列中快速查找常量，这些常量将扩展到整行，然后与感兴趣的范围相交；复制结果。请注意，如果A列中没有任何常量，则此操作将失败，并显示消息

未找到任何单元格

。使用错误处理。@DanC Excelosaurus/QHarr对您的其他问题有一个很好的解决方案。我将发布另一个解决方案作为我答案的一部分，以防您的原始文档中只有空白（我们将第二次循环所有粘贴的数据以删除空白行）。使用您现有的r，因为这非常有效！帮助我如何删除空白行粘贴时？我处理的每个范围都有空行。是否存在公式或只是硬编码的值？可能希望使用bookList.Sheets（5）.Range（“A2:Q366”）.SpecialCells（xlCellTypeConstants）假设用于查找空行的条件列可以是A并且包含常量（即非公式），请使用

Application.Intersect（bookList.Sheets（5）.Range（“A2:A366”）.SpecialCells（XlCellType.xlCellTypeConstants）.EntireRow，bookList.Sheets（5）.Range（“A2:Q366”））.复制…

。这里的原理是，SpecialCells将在criteria列中快速查找常量，这些常量将扩展到整行，然后与感兴趣的范围相交；复制结果。请注意，如果A列中没有任何常量，则此操作将失败，并显示消息

未找到任何单元格

。使用错误处理。@DanC Excelosaurus/QHarr对您的其他问题有一个很好的解决方案。我将发布另一个解决方案作为我回答的一部分，以防原始文档中有空白（我们将再次循环所有粘贴的数据以删除空白行）。