Объединение таблиц

[Alexsandraaa]

Привеет)) У меня есть две таблицы с выделенными значениями, мне нужно на основе этих двух таблиц создать две новых и на основе двух новых создать основную таблицу, где будут все данные по всем значениям. Я прикрепила пример исходных таблиц, значений в таблицах мало, а на самом деле их ооочень много. Помогите написать цикл или массив, я не знаю, который бы быстро записывал все эти данные в новые таблицы, при чем в новых таблицах некоторые значения в строках повторяются, а некоторые нет и плюс нужно, чтобы данные записывались с обоих листов, а не с одного. Надеюсь понятно если полностью не хотите всё это писать, скажите пожалуйста как записывать строки на VBA из несмежных ячеек и как их можно зациклить? Лист3,4 и 5,новые(объединенные) таблицы, я кинула для примера(что должно получиться)Тест.xlsx

[Aleksandr H.]

Лист4 с чего об'еденился?

[Alexsandraaa]

Объединение кода формы и кода столбца, а Год планирования, квартал и месяц пишем сами

[Aleksandr H.]

Вариант для лист3.
Добавьте новый Лист6 и запустите макрос

Sub s6()
    Dim s1 As Worksheet, sR As Worksheet
    Dim rRm
    Dim r1M, c1M
    Dim r, c
    
    Dim sNames As String
    sNames = "Лист1,Лист2"
    Dim arNames() As String
    arNames = Split(sNames, ",")
    Dim sInd As Integer
    Set sR = Sheets("Лист6")
    With sR
        .Cells.Clear
        .[a1] = "Код форми"
        .[b1] = "Код столбца"
        .[c1] = "Код строки"
        .[d1] = "Период"
        .[e1] = "ДО"
        .[f1] = "показатель"
    End With
    rRm = 2
    For sInd = 0 To UBound(arNames)
        Set s1 = Sheets(arNames(sInd))
        r1M = s1.Cells(s1.Rows.Count, "A").End(xlUp).Row
        c1M = s1.Cells(6, s1.Columns.Count).End(xlToLeft).Column
        For r = 7 To r1M
            For c = 2 To c1M
                If s1.Cells(r, c) <> "" Then
                    sR.Cells(rRm, "A") = s1.[c2]
                    sR.Cells(rRm, "B") = s1.Cells(6, c)
                    sR.Cells(rRm, "C") = s1.Cells(r, "A")
                    sR.Cells(rRm, "D") = s1.[c3]
                    sR.Cells(rRm, "E") = s1.[c4]
                    sR.Cells(rRm, "F") = s1.Cells(r, c)
                    rRm = rRm + 1
                End If
            Next c
        Next r
    Next sInd
End Sub

[Alexsandraaa]

Воууу
Да ладнооо, спасибо большое, буду разбираться с кодом но еще штука такая, это был просто пример, а на самом деле там этих строк тысячи, этот код подойдет для большого количества строк?

[Aleksandr H.]

это идея/вариант решения. Пилите под себя