Поскольку ваши две рабочие таблицы кажутся табличными по структуре со столбцами в первой строке и данными, начинающимися со второй, и вы по существу обогащаете строки во второй таблице информацией из совпадающих строк первой таблицы, рассмотрите возможность объединения SQL двумя таблицами иэкспортировать нужные столбцы.
Если вы используете Excel для Windows, вы можете подключиться к самой книге с помощью JET / ACE SQL Engine для запросов к различным диапазонам / таблицам.
SQL (объединение влево для сохранения всех строк целевого листа и получения «обогащающих» столбцов)
ПРИМЕЧАНИЕ. Обязательно замените столбцы фактическими заголовками первой строки. Ниже встроен VBA.
SELECT t.ColumnA, t.ColumnB, t.ColumnC, t.ColumnD, t.ColumnE
FROM [Absatzmenge$] a
LEFT JOIN [Transponieren$] t
ON t.[ColumnB] = a.[ColumnA] AND t.[ColumnC] = a.[ColumnB]
VBA (без циклов, без массивов, без копирования / вставки, без выбора / активации)
Sub RunSQL()
On Error GoTo ErrHandle
Dim conn As Object, rst As Object
Dim sql as String
' INITIALIZE ADO OBJECTS
Set conn = CreateObject("ADODB.Connection")
Set rst = CreateObject("ADODB.Recordset")
sql = "SELECT t.ColumnA, t.ColumnB, t.ColumnC, t.ColumnD, t.ColumnE" _
& " FROM [Absatzmenge$] a " _
& " LEFT JOIN [Transponieren$] t " _
& " ON t.[ColumnB] = a.[ColumnA] AND t.[ColumnC] = a.[ColumnB]"
' OPEN RECORDSET
conn.Open "Driver={Microsoft Excel Driver (*.xls, *.xlsx, *.xlsm, *.xlsb)};" _
& "Dbq=" & ThisWorkbook.FullName & ";"
rst.Open, conn
' EXPORT RESULTS STARTING IN E2 CELL
ThisWorkbook.Worksheets("Absatzmenge").Range("E2").CopyFromRecordset rst
' CLOSE AND RELEASE OBJECTS
rst.Close: conn.Close
ExitHandle:
Set rst = Nothing: Set conn = Nothing
Exit Sub
ErrHandle:
MsgBox Err.Number & " - " & Err.Description, vbCritical, "RUNTIME ERROR"
Resume ExitHandle
End Sub