VBA - Pick up data from same format in varies worksheets and paste to a master tracker


Hi everyone,

so I am trying to extract all the information from the raw data file (available for download into excel format daily, ~10 files per day) and paste each one of the sheets to my master tracker.

I have attached my raw file here, with 2 worksheets in 1 workbook, trying to transfer to a master tracker. In the master tracker you can see how I want them to be shown.

My current coding is just simply taking the exact cells from the raw file, and paste to the master tracker exact cells.

Dim wsCopy As Worksheet
Dim wsDest As Worksheet
Dim lCopyLastRow As Long
Dim lDestLastRow As Long
Set wsCopy = Workbooks("Raw file.xlsx").Worksheets("Sheet1")
Set wsDest = Workbooks("Master tracker.xlsm").Worksheets("Report")
wsCopy.Range("A9:E9").Copy _
wsCopy.Range("A12").Copy _
wsCopy.Range("A15:E15").Copy _
wsCopy.Range("A18").Copy _
wsCopy.Range("A21:E21").Copy _
wsCopy.Range("A26").Copy _
wsCopy.Range("A29").Copy _


  1. How can I keep adding the data from another new raw file (i.e. Sheet2, and sheet 3 4 5 6 7 in the future..) to the master tracker, without erasing the previous records? (like adding new record below the existing ones)
  1. My raw file has to be downloaded one by one each time. Is it possible to get the data from each of them as a workbook, rather than combining the different worksheets into one workbook? Which one is easier?

 Thanks for reading! You help would be much appreciated!



Selected Answer

This code will get you started. It works on the idea that you would receive a daily report and file the workbook in which it is contained away in your fileing system. The code below will ask you to browse for it, open it, extract data and close it - all in the background.

Option Explicit

Sub UpdateMasterTracker()
    ' 013

    Dim WbS         As Workbook                 ' data Source
    Dim WasOpen     As Boolean                  ' WbS was open before
    Dim WsS         As Worksheet                ' Source: worksheet to read from
    Dim WsT         As Worksheet                ' Target: worksheet to write to
    Dim Rt          As Long                     ' row to write to in Ws
    Dim Tmp         As Variant                  ' working variable

    WasOpen = GetDataSource(WbS)
    If WbS Is Nothing Then Exit Sub                     ' user cancelled
    Set WsS = WbS.Worksheets(1)                         ' select the first sheet in WbS

    Application.ScreenUpdating = False
    Set WsT = ThisWorkbook.Worksheets("Report")         ' change name to match
    With WsT
        Rt = .Cells(.Rows.Count, "A").End(xlUp).Row + 1 ' last used row in column A + 1
        Tmp = Split(WsS.Cells(1, 1).Value, ":")
        .Cells(Rt, "A").Value = Tmp(UBound(Tmp))        ' copy the date
        WsS.Range("A9:E9").Copy Destination:=.Cells(Rt, 2)
        WsS.Range("A12").Copy Destination:=.Cells(Rt, 7)
        WsS.Range("A15").Copy Destination:=.Cells(Rt, 8)
        WsS.Range("C15:E15").Copy Destination:=.Cells(Rt, 9)
        WsS.Range("A18").Copy Destination:=.Cells(Rt, 12)
    End With

    With Application
        .DisplayAlerts = False
        If Not WasOpen Then WbS.Close                   ' keep open if it was open
        .ScreenUpdating = True
        .DisplayAlerts = True
    End With
End Sub

Private Function GetDataSource(WbS As Workbook) As Boolean
    ' 013
    ' WbS will be Nothing if cancelled by user
    ' return True if WbS was open

    Dim Ffn         As Variant                  ' Full File Name
    Dim Tmp         As Variant                  ' working variable

    With Application.FileDialog(msoFileDialogFilePicker)
        .AllowMultiSelect = False
        .Filters.Add "Excel Files", "*.xlsx; *.xlsm; *.xls", 1
        If .Show Then
            Ffn = .SelectedItems.Item(1)
            Exit Function                   ' user cancelled
        End If
    End With

    Application.ScreenUpdating = False
    Tmp = Split(Ffn, Application.PathSeparator)
    On Error Resume Next
    Set WbS = Workbooks(Tmp(UBound(Tmp)))
    If Err Then                             ' workbook isn't open
        Set WbS = Workbooks.Open(Ffn)
        ActiveWindow.Visible = False        ' hide the workbook
    End If
    Application.ScreenUpdating = True

    GetDataSource = Not CBool(Err.Number)
End Function

Two things you need to know about merged cells in Excel. 

  1. The value of merged cells is always stored in the first cell of the merged range. All others are ignored.
  2. Merged cells viciously interfere with Excel's natural order of rows and columns. Nothing good ever comes from them. There are plenty of alternatives. Use them all before you merge cells - and then change your wishes, but don't merge cells.


OMG thank you so much! it works just as what I am expected!!! thank you very much!!

regarding merged cells, yes I have noticed it and I think i will un-merged everything and ensure the format (including blank lines or blank cells are removed/added) are identical for each of the worksheet i need to transfer to master tracker so that there won't be error.

Cant thank enough for this!
Skywalker527 (rep: 2) May 21, '20 at 11:27 pm
Add to Discussion

Answer the Question

You must create an account to use the forum. Create an Account or Login