Скопируйте несколько книг в определенную строку в другую книгу

Question

Ниже код VBA помогает мне импортировать все книги с указанного пути в основную книгу.

Код работает отлично

Однако, я хочу, чтобы настроить этот код немного, так что я могу поместить код в 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

Я понимаю вопрос в двух направлениях.

1. Если вы хотите, чтобы вставить данные 5 строк только ниже для первой книги, то попробуйте это

Я добавил счетчик для подсчета петель и в первом цикле Смещение 6 строк, а остальные петли - 2 строки. Вы также можете попробовать что-то более простое, но менее чистое. Перед тем, как запустить цикл for For Each everyObj In filesObj, вы можете поместить некоторый текст в Range («A5»), и таким образом, когда он ищет последнюю строку, он найдет Row 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 ... Диапазона ("A65536"). End (xlUp) .offset (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 

Answer 2

Вы можете просто активировать ячейку на 5 строк ниже текущей последней строки. Добавьте это после того, как bookList.Close и до Next:

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