Excel VBA Скопировать определенные данные на количество строк

Question

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

Sub Get_Data_From_File()
    Dim FileToOpen As Variant
    Dim OpenBook As Workbook
    Application.ScreenUpdating = False
    FileToOpen = Application.GetOpenFilename(Title:="Browse for your File & Import Range", Filefilter:="Excel Files (*.xls*),*xls*")
    If FileToOpen <> False Then
        Set OpenBook = Application.Workbooks.Open(FileToOpen, Password:="uraduct")
        Application.DisplayAlerts = False
        OpenBook.Sheets(1).Range("B3:B11").Copy
        ThisWorkbook.Worksheets("Data").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues, Transpose:=True
        Application.DisplayAlerts = False
        OpenBook.Sheets(1).Range("B19:U162").Copy
        ThisWorkbook.Worksheets("Data").Cells(Rows.Count, 10).End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues, Transpose:=True
        OpenBook.Close False

End If
Application.ScreenUpdating = True
On Error Resume Next
Columns("K").SpecialCells(xlBlanks).EntireRow.Delete

End Sub

По сути, B3: B11 - это заголовок, и я хочу, чтобы он появлялся в каждой строке, которая выводится на B19: U162, который представляет собой 1 столбец или 20 столбцов, преобразованных в строки (на основе удаления в конце).

Кроме того, в некоторых случаях пользователь не заполнил строку / столбец 19, поэтому, если строка / столбец 20 заполнено, я хотел бы добавить значение по умолчанию для строки 19, чтобы предотвратить его перезапись при следующей загрузке файла.

Надеюсь, это имеет смысл.

Спасибо,

Answer 1

Проверить ячейку ("B19") и, если она пуста, не вычислить ни одного столбца из строки 20, заполнить строку. Закройте исходную книгу без сохранения изменений.

Application.DisplayAlerts = False
Dim cols As Integer
If OpenBook.Sheets(1).Range("B19") = "" Then
    cols = OpenBook.Sheets(1).Cells(20, Columns.Count).End(xlToLeft).Column - 1
    OpenBook.Sheets(1).Range("B19").Resize(1, cols).Value = "empty"
End If
OpenBook.Sheets(1).Range("B19:U162").Copy