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

Any help would be greatly appreciated. What I'm trying to accomplish is to take the same range from multiple workbooks and paste into a single separate workbook. The issue that I am running into is that I would like to have the data paste down into the next available row. My current code does everything correctly except the paste vba (the data is currently overlapping)

任何帮助将不胜感激。我想要完成的是从多个工作簿中获取相同的范围并粘贴到单个单独的工作簿中。我遇到的问题是我希望将数据粘贴到下一个可用行中。我的当前代码完成所有操作,除了粘贴vba(数据当前重叠)

Also the ranges I am copying from have blank rows so a way to have the paste code remove blank rows would be amazing.

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

Any help in this would fantastic!

任何帮助都会很棒!

Thank you in advance

先谢谢你

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 个解决方案

#1

You need to define the last row, then paste into last row + 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

Edit

Adding in the second part of the question. Assuming all blank rows are copied to the master destination sheet, so we just need to remove blanks there... note that this might be slow, depending on how many lines you've got:

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

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