VBA code Excel extract specific cell value from a tab into a table on a different Excel file

Question

Seems this is the challenge of the year as everyone been struggling to get this done.

Basically I'm trying to get a code to extract the values on the cell B1, B2, B3, A6, B6, C6 and D6 into a new spreadsheet. This extraction is from around 20 different tabs containing the data exactly in the same cells, so my VBA code need to extract the values on those cells above from 20 different tabs and add it on all together into a single new spreadsheet?

Is this possible? I attached a image which explain what's the outcome needed.

Thanks a lot!!

Code below:

Sub TEST()
        Dim value1 As String
        value1 = ThisWorkbook.Sheets(1).Range("B1").Value 'value from sheet1
        value2 = ThisWorkbook.Sheets(1).Range("B2").Value 'value from sheet1
        value3 = ThisWorkbook.Sheets(1).Range("B3").Value 'value from sheet1
        value4 = ThisWorkbook.Sheets(1).Range("A6").Value 'value from sheet1
        value5 = ThisWorkbook.Sheets(1).Range("B6").Value 'value from sheet1
        value6 = ThisWorkbook.Sheets(1).Range("C6").Value 'value from sheet1
        value7 = ThisWorkbook.Sheets(1).Range("D6").Value 'value from sheet1
Then ThisWorkbook.Sheets(2).Range("L1").
End Sub

Answer 1

Create a worksheet in the same workbook with all 20 other tabs called "Combined". Set up the headers in row 1 to match your picture....Dates, Price, Qty, Cost, Colour...etc. Then this code should get you what you want. Put it into a standard code module.

Option Explicit

Sub AggregateData()

Dim ws As Worksheet
Dim comb As Worksheet
Dim lastrow As Long

Set comb = ThisWorkbook.Worksheets("Combined")

For Each ws In ThisWorkbook.Worksheets

    If ws.Name = "Combined" Then
    'skips the combined worksheet.
    Else
        lastrow = comb.Cells(Rows.Count, "a").End(xlUp).Row + 1
        
        comb.Range("a" & lastrow & ":d" & lastrow).Value = ws.Range("a6:d6").Value
        comb.Range("e" & lastrow & ":g" & lastrow).Value = Application.Transpose(ws.Range("b1:b3").Value)
    End If
Next ws

End Sub