Копирование данных из нескольких рабочих книг в один мастер-файл: данные не введены в одну строку

Question

У меня есть код для копирования из нескольких рабочих книг в один мастер-файл.но проблема здесь в том, что есть вероятность, что файл данных будет содержать пустую строку.Поэтому каждый раз, когда добавляются новые данные, вместо того, чтобы находиться в одной строке, они перемещаются вверх, чтобы заполнить весь пустой столбец.Извините, если мои слова не ясны, английский не мой родной язык.Я приложил пример здесь

Ожидаемый результат

A     B      C      D       E
bb   1234    cc     
ff   3242    ff     
fjn  7643    jk    fjnnD  fjnnE
gwd  9754    jk    gjwdD  gjwdE

Результат, который я получаю

A     B      C      D       E
bb   1234    cc     fjnnD  fjnnE
ff   3242    ff     gjwdD  gjwdE
fjn  7643    jk    
gwd  9754    jk    

Вот мой код

Sub UploadData()

Dim SummWb As Workbook
Dim SceWb As Workbook

'Get folder containing files
With Application.FileDialog(msoFileDialogFolderPicker)
    .AllowMultiSelect = False
    .Show
    On Error GoTo Error_handler
    myFolderName = .SelectedItems(1)
    'Err.Clear
    'On Error GoTo 0
End With

If Right(myFolderName, 1) <> "\" Then myFolderName = myFolderName & "\"
    'Settings
    Application.ScreenUpdating = False
    oldStatusBar = Application.DisplayStatusBar
    Application.DisplayStatusBar = True
    Set SummWb = ActiveWorkbook
    'Get source files and append to output file
    mySceFileName = Dir(myFolderName & "*.*")

        Do While mySceFileName <> "" 'Stop once all files found
            Application.StatusBar = "Processing: " & mySceFileName
            Set SceWb = Workbooks.Open(myFolderName & mySceFileName) 'Open file found
                With SummWb.Sheets("Master List")
                                     Dim maxLastRow As Long
             Dim columnsToAppendTo As Variant
             columnsToAppendTo = Array("A", "B", "C", "D", "E", "I", "J", "K", "L", "M", "N", "F")
             Dim index As Long

            For index = LBound(columnsToAppendTo) To UBound(columnsToAppendTo)
            maxLastRow = Application.Max(.Cells(.Rows.Count, columnsToAppendTo(index)).End(xlUp).Row, maxLastRow)
            Next index

                .Cells(maxLastRow + 1, "A").Value = SceWb.Sheets("Survey").Range("B3").Value
                .Cells(maxLastRow + 1, "C").Value = SceWb.Sheets("Survey").Range("B4").Value
                .Cells(maxLastRow + 1, "D").Value = SceWb.Sheets("Survey").Range("B5").Value
                .Cells(maxLastRow + 1, "E").Value = SceWb.Sheets("Survey").Range("B6").Value
                .Cells(maxLastRow + 1, "I").Value = SceWb.Sheets("Survey").Range("C9").Value
                .Cells(maxLastRow + 1, "J").Value = SceWb.Sheets("Survey").Range("D9").Value
                .Cells(maxLastRow + 1, "K").Value = SceWb.Sheets("Survey").Range("C10").Value
                .Cells(maxLastRow + 1, "L").Value = SceWb.Sheets("Survey").Range("D10").Value
                .Cells(maxLastRow + 1, "M").Value = SceWb.Sheets("Survey").Range("C11").Value
                .Cells(maxLastRow + 1, "N").Value = SceWb.Sheets("Survey").Range("D11").Value
                .Cells(maxLastRow + 1, "F").Value = SummWb.Sheets("Upload Survey").Range("C8").Value
                End With
            SceWb.Close (False) 'Close Workbook
            mySceFileName = Dir

        Loop
MsgBox ("Upload complete.")
'Settings and save output file
Application.StatusBar = False
Application.DisplayStatusBar = oldStatusBar
SummWb.Activate
SummWb.Save 'save automaticallly
Application.ScreenUpdating = True
Exit Sub
Error_handler:
MsgBox ("You cancelled the action.")

End Sub

Яугадал проблему с помощью оператора End (xlUp).Любая помощь очень ценится.

правка (удаленная часть кода)

.Cells(.Rows.Count, "A").End(xlUp).Offset(1, 0).Value = SceWb.Sheets("Survey").Range("B3").Valu
.Cells(.Rows.Count, "C").End(xlUp).Offset(1, 0).Value = SceWb.Sheets("Survey").Range("B4").Value
.Cells(.Rows.Count, "D").End(xlUp).Offset(1, 0).Value = SceWb.Sheets("Survey").Range("B5").Value
.Cells(.Rows.Count, "E").End(xlUp).Offset(1, 0).Value = SceWb.Sheets("Survey").Range("B6").Value
.Cells(.Rows.Count, "I").End(xlUp).Offset(1, 0).Value = SceWb.Sheets("Survey").Range("C9").Value
.Cells(.Rows.Count, "J").End(xlUp).Offset(1, 0).Value = SceWb.Sheets("Survey").Range("D9").Value
.Cells(.Rows.Count, "K").End(xlUp).Offset(1, 0).Value = SceWb.Sheets("Survey").Range("C10").Value
.Cells(.Rows.Count, "L").End(xlUp).Offset(1, 0).Value = SceWb.Sheets("Survey").Range("D10").Value
.Cells(.Rows.Count, "M").End(xlUp).Offset(1, 0).Value = SceWb.Sheets("Survey").Range("C11").Value
.Cells(.Rows.Count, "N").End(xlUp).Offset(1, 0).Value = SceWb.Sheets("Survey").Range("D11").Value
.Cells(.Rows.Count, "F").End(xlUp).Offset(1, 0).Value = SummWb.Sheets("Upload Survey").Range("C8").Value

Answer 1

Вам нужно использовать End(xlUp) только один раз, и тогда все остальные значения должны идти в той же строке: не запускайте его отдельно в каждом столбце.Вам нужно выбрать столбец, в котором не будет пробелов.

Например: использование ColA

With SummWb.Sheets("Master List").Cells(rows.count,1).end(xlup).offset(1,0).Entirerow
    .cells(1).value = 'whatever
    .cells(2).value = 'other value
    'etc etc
end with

Answer 2

непроверенная.Возможно, есть лучший способ сделать это, но после этой строки:

With SummWb.Sheets("Master List")

Put

Dim maxLastRow as long
Dim columnsToAppendTo as variant
columnsToAppendTo = array("A", "B", "C", "D", "E", "I", "J", "K", "L", "M", "N", "F")

Dim index as long

For index = lbound(columnsToAppendTo) to ubound(columnsToAppendTo)

maxLastRow = application.max(.cells(.Rows.Count,  columnsToAppendTo(index)).End(xlUp).row, maxLastRow)

Next index

Затем переписать часть кода, в которой вы на самом деле пишете мастеру.файл, как таковой:

.Cells(maxLastRow + 1, "A").Value = SceWb.Sheets("Survey").Range("B3").Value ' Use offset instead of +1 if you need to '

и т. д.

Основное отличие состоит в том, что вы сначала обрабатываете последнюю строку во всех столбцах сначала / заранее, а затем используете это конкретное значение последней строки длякаждый столбец.