Данные не копируются в одну строку (несколько рабочих книг на основной лист)

Question

У меня есть подпрограмма VBA для копирования выбранных ячеек из нескольких рабочих книг в один мастер-файл. Но есть проблема в том, что есть вероятность, что одна или несколько исходных (входных) рабочих книг будут содержать пустые ячейки. Таким образом, когда данные из последующих входов копируются, вместо того, чтобы находиться в той же строке, они будут перемещаться вверх, чтобы заполнить весь пустой столбец. Извините, если мои слова не ясны; Английский не мой родной язык. Я приложил пример здесь:

вход

        B3    B4     B5     B6      C9
book1   bb   1234    cc
book2   ff   3242    ff
book3   fjn  7643    jk    fjnnD   fjnnE
book4   gwd  9754    jk    gjwdD   gjwdE

Ожидаемый результат (в основном файле)

        A     B      C      D       E
Row 1   bb   1234    cc     
Row 2   ff   3242    ff     
Row 3   fjn  7643    jk    fjnnD   fjnnE
Row 4   gwd  9754    jk    gjwdD   gjwdE

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

        A     B      C      D       E
Row 1   bb   1234    cc    fjnnD   fjnnE
Row 2   ff   3242    ff    gjwdD   gjwdE
Row 3   fjn  7643    jk    
Row 4   gwd  9754    jk    

Вот мой код Включает логику для сканирования каталога на наличие входных файлов. Это работает правильно, так что вы можете игнорировать это. Проблема заключается в коде для копирования данных из одной выбранной (открытой) рабочей книги на лист « Основной список» в активной рабочей книге (SummWb).

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")
        .Cells(.Rows.Count, "A").End(xlUp).Offset(1, 0).Value = SceWb.Sheets("Survey").Range("B3").Value
        .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
    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) . Любая помощь очень ценится.

Answer 1

Вы совершенно правы - метод End(xlUp) эффективно находит последнюю непустую ячейку в каждом столбце.  Итак, в вашем искусственном примере последняя непустая ячейка в столбцах A , B и C - строка 4, а последняя непустая ячейка в столбцах D и E - строка 2.  Вы хотите найти последнюю строку, где есть (непустые) данные, по всем столбцам.

Может быть быстрый и легкий способ сделать это, и, если так, я хотел бы изучить это.  Но вот несколько грубый способ сделать это:

Сначала определите целочисленную переменную с именем maxrow:

Dim maxrow As Integer

(На самом деле, вам не нужно это делать, но это хорошая форма.)

Затем найдите последнюю строку, которая содержит (непустые) данные в любом столбце, просто взглянув на все столбцы и взяв максимум.  В начале вашего With SummWb.Sheets("Master List") блок, сделать

    maxrow = 0
    maxrow = Application.Max(maxrow, .Cells(.Rows.Count, "A").End(xlUp).Row)
    maxrow = Application.Max(maxrow, .Cells(.Rows.Count, "C").End(xlUp).Row)
    maxrow = Application.Max(maxrow, .Cells(.Rows.Count, "D").End(xlUp).Row)
    maxrow = Application.Max(maxrow, .Cells(.Rows.Count, "E").End(xlUp).Row)
      ︙

И так далее для остальных семи столбцов, которые вы используете.  Тогда делай

    .Cells(maxrow + 1, "A") = SceWb.Sheets("Survey").Range("B3").Value
    .Cells(maxrow + 1, "C") = SceWb.Sheets("Survey").Range("B4").Value
    .Cells(maxrow + 1, "D") = SceWb.Sheets("Survey").Range("B5").Value
    .Cells(maxrow + 1, "E") = SceWb.Sheets("Survey").Range("B6").Value
             ︙

И так далее для остальных семи столбцов / значений.  Быстрые заметки:

• + 1 (в maxrow + 1) занимает место .Offset(1, 0) , поэтому вы копируете в строку ниже последней строки (а не перезаписываете данные в последней строке).
• Насколько я могу судить, вам не нужно .Value по обе стороны от назначения.  Я оставил их справа, потому что мне вообще не нужно было менять правую сторону.  Если вы чувствуете себя авантюрным, попробуйте удалить их.  Если вы найдете причину, по которой они вам нужны, слева (например .Cells(maxrow + 1, "A").Value = …), верните их обратно (и дайте мне знать, зачем вам это нужно).