Question

以下VBA代码帮助我将所有工作簿从指定路径导入到主工作簿。

代码完美无缺

但是，我想稍微调整一下这段代码，以便我可以将代码放在Master工作簿的第5行

以下代码可帮助我将数据放在下面一行

任何人都可以帮我改变代码，将数据粘贴到当前工作簿的第5行。

Sub mergeworkbooks()
Dim bookList As Workbook
Dim mergeObj As Object, dirObj As Object, filesObj As Object, everyObj As Object


Application.ScreenUpdating = False
Set mergeObj = CreateObject("Scripting.FileSystemObject")


Set dirObj = mergeObj.Getfolder("C:\Users\admin\Desktop\SLO 23032015")
Set filesObj = dirObj.Files
For Each everyObj In filesObj
Set bookList = Workbooks.Open(everyObj)

Range("A2:IV" & Range("A65536").End(xlUp).Row).Copy
ThisWorkbook.Worksheets(1).Activate

Range("A65536").End(xlUp).Offset(2, 0).PasteSpecial


Application.CutCopyMode = False
bookList.Close
Next
End Sub

Answer 1

您可以激活当前最后一行下方的5行单元格。在bookList.Close之后和Next之前添加：

FifthRow = ActiveSheet.Cells.Find(What:="*", SearchDirection:=xlPrevious, SearchOrder:=xlByRows).Row + 5
Cells(FifthRow, 1).Activate

Answer 2

我从两个方面理解这个问题。

如果您想仅为第一个工作簿粘贴5行以下数据，请尝试使用

我添加了计数器来计算循环，在第一个循环中偏移是6行，其余循环是2行。你也可以尝试一些更简单但更不干净的东西，比如在运行for循环For Each everyObj In filesObj之前你可以在Range（＆＃34; A5＆＃34;）中加入一些文本，这样当它寻找最后一行时它会找到第6行而不是第5行，但这是一个偏好问题。示例Range("A5").Value = "SomeText"

Sub mergeworkbooks()
Dim bookList As Workbook
Dim mergeObj As Object, dirObj As Object, filesObj As Object, everyObj As Object
Dim iCount as Long

Application.ScreenUpdating = False
Set mergeObj = CreateObject("Scripting.FileSystemObject")


Set dirObj = mergeObj.Getfolder("C:\Users\admin\Desktop\SLO 23032015")
Set filesObj = dirObj.Files

iCount = 1
For Each everyObj In filesObj
Set bookList = Workbooks.Open(everyObj)

Range("A2:IV" & Range("A65536").End(xlUp).Row).Copy
ThisWorkbook.Worksheets(1).Activate
If iCount = 1 then 
    Range("A" & Rows.Count).End(xlUp).Offset(6, 0).PasteSpecial
    iCount = 0
Else
    Range("A" & Rows.Count).End(xlUp).Offset(2, 0).PasteSpecial
end if

Application.CutCopyMode = False
bookList.Close
Next
End Sub

否则，如果您想要在所有工作簿之间粘贴数据的5行差距，请使用以下代码我只是将下面一行的偏移量从2改为6 ...... 范围（＆＃34; A65536＆＃34;）。结束（xlUp）。偏移（6,0）.PasteSpecial

Sub mergeworkbooks()
Dim bookList As Workbook
Dim mergeObj As Object, dirObj As Object, filesObj As Object, everyObj As Object


Application.ScreenUpdating = False
Set mergeObj = CreateObject("Scripting.FileSystemObject")


Set dirObj = mergeObj.Getfolder("C:\Users\admin\Desktop\SLO 23032015")
Set filesObj = dirObj.Files
For Each everyObj In filesObj
Set bookList = Workbooks.Open(everyObj)

Range("A2:IV" & Range("A65536").End(xlUp).Row).Copy
ThisWorkbook.Worksheets(1).Activate

Range("A" & Rows.Count).End(xlUp).Offset(6, 0).PasteSpecial


Application.CutCopyMode = False
bookList.Close
Next
End Sub

将多个工作簿复制到另一个工作簿中的特定行

2 个答案: