Excel VBA 将某些数据向下复制 x 行数

Question

I am new to VBA, normally i would just resort to excel formulas. I am writing a record database that extracts information from the users chosen excel sheet. I have found code over the web that i have bodged together to get this: -

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

Basically, the B3:B11 is a title and i want it to appear on each row that is brought through on the B19:U162 which is either 1 column or 20 columns converted to rows (based on the delete at the end).

Also, in some cases the user has not filled in row/column 19 so if row/column 20 is filled i would like to add a default to row 19 to prevent it being overwrote on the next file upload.

I hope that makes sense.

Thank you,

Answer 1

Test cell("B19") and if empty calculate no of columns from row 20 then fill in the row. Close source workbook without saving changes.

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