Код VBA Excel, извлечение указанного c значение ячейки из вкладки в таблицу в другом файле Excel

Question

Кажется, это вызов года, поскольку все изо всех сил пытались это сделать.

В основном я пытаюсь получить код для извлечения значений в ячейке B1, B2, B3, A6, B6, C6 и D6 в новую таблицу. Это извлечение происходит примерно из 20 различных вкладок, содержащих данные точно в одних и тех же ячейках, поэтому моему коду VBA необходимо извлечь значения в этих ячейках выше из 20 разных вкладок и добавить их все вместе в одну новую электронную таблицу?

Возможно ли это? Я прикрепил изображение, объясняющее, какой результат нужен.

Большое спасибо !!

введите описание изображения здесь

Код ниже:

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

Создайте рабочий лист в той же книге со всеми 20 другими вкладками под названием «Комбинированный». Задайте заголовки в строке 1, чтобы они соответствовали вашему изображению .... Даты, Цена, Кол-во, Стоимость, Цвет ... и т. Д. c. Тогда этот код должен дать вам то, что вы хотите. Поместите его в стандартный кодовый модуль.

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