[VBA] Сведение двух таблиц макросом

[Елена195]

Теперь все получилось, спасибо больше!

[Елена195]

Сергей, вы мне в прошлый раз очень помогли. Но к сожалению у меня возникла новая загвоздка.
В добавилась еще одна таблица S-Y, данные из которой нужно так же соотносить с данными из таблицы B-G.
Попыталась модифицировать макрос, и теперь не могу понять что они мне выдает, но вижу что не все.
Подскажите пожалуйста, как это можно исправить?

Файл во вложении

Sub Списочек()

    Sheets("C").Select
    Dim sh1 As Worksheet
    Dim sh2 As Worksheet
    
    Dim iLastRow As Integer
    Dim iLastCol As Integer
    Dim i%, j%, r%, ColumnOffset%
    Set sh1 = Sheets("Сетка")
    Set sh2 = Sheets("C"): sh2.Range("a2:j50000").ClearContents
    ScreensOFF
    With sh1 ' работаем с первым листом
        iLastRow = .Cells(.Rows.Count, "B").End(xlUp).Row
        iLastCol = .Cells(3, .Columns.Count).End(xlToLeft).Column
        r = 1 'сколько строк отступаем от первой
        ColumnOffset = .Range("L1").Column - .Range("C1").Column
        For j = .Range("C1").Column To .Range("G1").Column
           For i = 2 To iLastRow
                If .Cells(i, j + ColumnOffset) <> "" Then
                    r = r + 1
                    
                    sh2.Cells(r, "A") = .Cells(1, j)
                    sh2.Cells(r, "C") = .Cells(i, j)
                    sh2.Cells(r, "B") = .Cells(i, "B")
                    sh2.Cells(r, "d") = .Cells(i, j + ColumnOffset)
                   
                End If
            Next i
        Next j
      

    End With
    
  With sh1 ' работаем с первым листом
        iLastRow = .Cells(.Rows.Count, "B").End(xlUp).Row
        iLastCol = .Cells(3, .Columns.Count).End(xlToLeft).Column
        r = 1 'сколько строк отступаем от первой
        ColumnOffset = .Range("u1").Column - .Range("C1").Column
        For j = .Range("C1").Column To .Range("G1").Column
           For i = 2 To iLastRow
                If .Cells(i, j + ColumnOffset) <> "" Then
                    r = r + 1
                    
                    sh2.Cells(r, "A") = .Cells(1, j)
                    sh2.Cells(r, "C") = .Cells(i, j)
                    sh2.Cells(r, "B") = .Cells(i, "B")
                    sh2.Cells(r, "d") = .Cells(i, j + ColumnOffset)
                   
                End If
            Next i
        Next j
      

    End With
 
    Set sh1 = Nothing
    Set sh2 = Nothing
      
  ScreensON
End Sub

Спасибо)