将一列数据添加到另一个工作表 excel 上的现有列表

Question

我有一个宏，可将数据从单独的工作簿导入我的仪表板，并将数据放入 B-J 列。每次运行宏时，它都会清除 B-J 列以更新仪表板的实时信息。我需要将 B 列和 D 列中的数据拉到一个单独的工作表中，并创建一个所有数据的运行列表。该文档在一天开始时为空白，我的员工整天都在使用此仪表板刷新数据，但我需要在另一张纸上保留这两列信息。我如何将其合并到我目前拥有的代码中？

Sub Get_Data_From_File()
    Dim FileToOpen As Variant
    Dim OpenBook As Workbook
    Dim sourceSheet As Worksheet
    Set sourceSheet = ActiveSheet
     
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    Application.Calculation = xlCalculationManual
        
    Sheets("Closed OB").Visible = True
    Sheets("Temp Closed").Visible = True
    
    Sheets("Closed OB").Select
    Range("A:J").ClearContents
    
    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)
        OpenBook.Sheets(1).Range("A4:G1000").Copy
        ThisWorkbook.Worksheets(3).Range("A1:G1000").Value = OpenBook.Sheets(1).Range("A4:G1000").Value
        OpenBook.Sheets(1).Range("H4:H1000").Copy
        ThisWorkbook.Worksheets(3).Range("J1:J1000").Value = OpenBook.Sheets(1).Range("H4:H1000").Value
        OpenBook.Sheets(2).Range("A4:M1000").Copy
        ThisWorkbook.Worksheets(4).Range("A2:R998").Value = OpenBook.Sheets(2).Range("A4:M1000").Value
        OpenBook.Close False
    End If
        
    ThisWorkbook.Worksheets("Closed OB").Range("G1").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.TextToColumns Destination:=Range("G1"), DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=True, Tab:=False, _
        Semicolon:=False, Comma:=False, Space:=True, Other:=False, FieldInfo _
        :=Array(Array(1, 1), Array(2, 1), Array(3, 1)), TrailingMinusNumbers:=True
    
    LastRow = Sheets(4).UsedRange.SpecialCells(xlCellTypeLastCell).Row
    
    Call BackupColumns
    
    Sheets("Temp Closed").Select
    With Range("D2:D" & LastRow)
        .NumberFormat = General
        .Value = .Value
    
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
    End With
    
    Sheets("Closed OB").Visible = False
    Sheets("Temp Closed").Visible = False
    
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
    Application.Calculation = xlCalculationAutomatic
         
    Call sourceSheet.Activate
    
End Sub