Все строки после первого файла на одну строку

У меня есть код, который печатает одну ячейку имени в столбцах 1 и 4 и информацию, соответствующую этим именам в столбцах 2 и 3, которые занимают много строк.

Первый файл работает хорошо, но все последующие печатают одну строку ниже, чем они должны быть. Я играю с этим, и я думаю, что это простое решение для +1, где не должно быть или нужно убрать +1 для следующих файлов .. но я не могу его найти. Вот образ того, что происходит. Мой код приведен ниже. Раздел (5) – это где я печатаю информацию в столбцах 1 и 4. Любые идеи?

введите описание изображения здесь

ПОЛНЫЙ КОД:

Option Explicit Sub LoopThroughDirectory() Dim objFSO As Object Dim objFolder As Object Dim objFile As Object Dim MyFolder As String Dim StartSht As Worksheet, ws As Worksheet Dim WB As Workbook Dim i As Integer Dim LastRow As Integer, erow As Integer Dim Height As Integer Dim RowLast As Long 'turn screen updating off - makes program faster 'Application.ScreenUpdating = False 'location of the folder in which the desired TDS files are MyFolder = "C:\Users\trembos\Documents\TDS\progress\" 'Set StartSht = ActiveSheet Set StartSht = Workbooks("masterfile.xlsm").Sheets("Sheet1") 'create an instance of the FileSystemObject Set objFSO = CreateObject("Scripting.FileSystemObject") 'get the folder object Set objFolder = objFSO.GetFolder(MyFolder) i = 1 'loop through directory file and print names '(1) For Each objFile In objFolder.Files If LCase(Right(objFile.Name, 3)) = "xls" Or LCase(Left(Right(objFile.Name, 4), 3)) = "xls" Then '(2) 'print file name to Column 1 Set WB = Workbooks.Open(fileName:=MyFolder & objFile.Name) Set ws = WB.ActiveSheet '(3) 'copy HOLDER column from F11 (11, 6) until empty With ws LastRow = GetLastRowInColumn(ws, "A") .Range(.Cells(11, 6), .Cells(LastRow, 6)).Copy End With Dim destination LastRow = GetLastRowInColumn(StartSht, "B") Set destination = StartSht.Range("B" & LastRow).Offset(1) 'print HOLDER column to column 2 in masterfile in next available row destination.PasteSpecial '(4) 'ReDefine the destination range to paste into Column C LastRow = GetLastRowInColumn(StartSht, "C") Set destination = StartSht.Range("C" & LastRow).Offset(1) With ws 'copy CUTTING TOOL column from F11 (11, 7) until empty LastRow = GetLastRowInColumn(ws, "G") 'print CUTTING TOOL column to column 3 in masterfile in next available row .Range(.Cells(11, 7), .Cells(LastRow, 7)).Copy _ destination:=destination End With '(5) With WB 'print TDS information For Each ws In .Worksheets 'print the file name to Column 1 StartSht.Cells(i + 1, 1) = objFile.Name 'print TDS name to Column 4 With ws .Range("J1").Copy StartSht.Cells(i + 1, 4) End With i = GetLastRowInSheet(StartSht) + 1 'move to next file Next ws '(6) 'close, do not save any changes to the opened files .Close SaveChanges:=False End With End If 'move to next file Next objFile 'turn screen updating back on 'Application.ScreenUpdating = True ActiveWindow.ScrollRow = 1 '(7) End Sub Function GetLastRowInColumn(theWorksheet As Worksheet, col As String) With theWorksheet GetLastRowInColumn = .Range(col & .Rows.count).End(xlUp).Row End With End Function Function GetLastRowInSheet(theWorksheet As Worksheet) Dim ret With theWorksheet If Application.WorksheetFunction.CountA(.Cells) <> 0 Then ret = .Cells.Find(What:="*", _ After:=.Range("A1"), _ Lookat:=xlPart, _ LookIn:=xlFormulas, _ SearchOrder:=xlByRows, _ SearchDirection:=xlPrevious, _ MatchCase:=False).Row Else ret = 1 End If End With GetLastRowInSheet = ret End Function 

Вы используете переменную i для отслеживания той строки, в которой вы должны заполнить столбцы A и D. Вы инициализируете i = 1 а затем добавляете 1 каждый раз, когда вы пишете на листе. .Cells(i + 1,... Но вы также добавляете 1 при обновлении переменной i = GetLastRowInSheet(StartSht) + 1

Я предлагаю вам инициализировать i = 2 а затем записать в строку i

 '(5) With WB 'print TDS information For Each ws In .Worksheets 'print the file name to Column 1 StartSht.Cells(i, 1) = objFile.Name 'print TDS name to Column 4 With ws .Range("J1").Copy StartSht.Cells(i, 4) End With i = GetLastRowInSheet(StartSht) + 1 ' this gets the row number for the next file 'move to next file Next ws 
  • См. Именованный диапазон от значения ячейки в цикле
  • Функция Excel OFFSET в r
  • Excel: объединение OFFSET с CELL
  • Excel. Определите, выполняется ли несколько критериев.
  • Формула смещения Excel с использованием диапазона
  • В Excel: с массивом, как получить дубликаты данных?
  • Пропуск колонки в функции OFFSET в зависимости от месяца в Excel
  • Как сформулировать функцию смещения для n-го столбца на другом листе
  • Excel: Vlookup в именованном диапазоне и возвращает значение за пределами диапазона
  • Функция смещения Excel VBA
  • Перетащите формулу и сделайте ссылку на каждую другую ячейку
  • Давайте будем гением компьютера.