Как сопоставить заголовок в разных листах и ​​скопировать / вставить вторую строку, если есть совпадение?

У меня есть документ Excel с двумя разными листами. В листе 1 имеется много столбцов с именами заголовков и пустыми строками. В листе 2 есть некоторые из этих столбцов с точными заголовками заголовков и записью во 2-й строке.

Я хочу создать макрос, который будет просматривать все заголовки столбцов в Листе 2 и найти их соответствующее соответствие в Sheet1. Когда совпадение найдено, мне нужно скопировать запись в строке 2 заголовка Sheet2 в соответствующий заголовок листа1. Некоторые записи в Sheet1 не будут совпадать и останутся пустыми.

Мои 2 листа в настоящее время:

Лист1

apple | orange | mango | grape | banana ------------------------------------------ [BLANK] |[BLANK] |[BLANK] |[BLANK] | [BLANK] 

Sheet2

 orange | mango | banana -------------------------- yumm | yuck | maybe 

То, что я хочу, после запуска макроса:

Лист1

 apple | orange | mango | grape | banana ------------------------------------------ [BLANK] |yumm |yuck |[BLANK] | maybe 

Я изучаю VBA, около 2 недель. У меня возникают проблемы с получением моей программы для этого. Я видел подобные вопросы, но они обычно соответствуют одному элементу в одном столбце, а не нескольким именам в нескольких столбцах. Коды, которые я пробовал, не сделали ничего похожего на то, что мне нужно.

Кроме того, это должно выполняться как макрос или функция, поскольку программа будет отправлена ​​пользователю, для которого это нужно сделать уже автоматически. Я думаю, что выполнение VLOOKUP не будет работать здесь, так как я не буду знать количество столбцов на любом листе, пока пользователь не войдет в них, и в этом случае программа автоматически заполнит строку 2 соответствующих. Есть идеи?

Это будет сделано, если имена листов будут Sheet1 и Sheet2 .

 Sub colLookup() Dim ShtOne As Worksheet, ShtTwo As Worksheet Dim shtOneHead As range, shtTwoHead As range Dim headerOne As range, headerTwo As range Set ShtOne = Sheets("Sheet1") Set ShtTwo = Sheets("Sheet2") Dim lastCol As Long 'get all of the headers in the first sheet, assuming in row 1 lastCol = ShtOne.Cells(1, Columns.count).End(xlToLeft).column Set shtOneHead = ShtOne.range("A1", ShtOne.Cells(1, lastCol)) 'get all of the headers in second sheet, assuming in row 1 lastCol = ShtTwo.Cells(1, Columns.count).End(xlToLeft).column Set shtTwoHead = ShtTwo.range("A1", ShtTwo.Cells(1, lastCol)) 'actually loop through and find values For Each headerTwo In shtTwoHead For Each headerOne In shtOneHead If headerTwo.Value = headerOne.Value Then headerOne.Offset(1, 0).Value = headerTwo.Offset(1, 0).Value End If Next headerOne Next headerTwo End Sub 

EDIT: в соответствии с обсуждением в комментариях желательно использовать метод копирования и вставки. Это удерживает ячейки как список вниз, хотя я не думаю, что падение все равно будет работать. Если это нежелательно, можно изменить xlPasteAll в другие форматы, такие как xlPasteValues . Другие указаны в документации Microsoft .

 Sub colLookup() Dim ShtOne As Worksheet, ShtTwo As Worksheet Dim shtOneHead As range, shtTwoHead As range Dim headerOne As range, headerTwo As range Set ShtOne = Sheets("Sheet1") Set ShtTwo = Sheets("Sheet2") Dim lastCol As Long 'get all of the headers in the first sheet, assuming in row 1 lastCol = ShtOne.Cells(1, Columns.count).End(xlToLeft).column Set shtOneHead = ShtOne.range("A1", ShtOne.Cells(1, lastCol)) 'get all of the headers in second sheet, assuming in row 1 lastCol = ShtTwo.Cells(1, Columns.count).End(xlToLeft).column Set shtTwoHead = ShtTwo.range("A1", ShtTwo.Cells(1, lastCol)) 'actually loop through and find values For Each headerTwo In shtTwoHead For Each headerOne In shtOneHead If headerTwo.Value = headerOne.Value Then headerTwo.Offset(1, 0).Copy headerOne.Offset(1, 0).PasteSpecial xlPasteAll Application.CutCopyMode = False End If Next headerOne Next headerTwo End Sub 
Interesting Posts

Чтение вычисленных данных из ячейки формулы с формулой RTD в форме Excel 2007 Java-приложение

Добавление символа в каждое слово в ячейке в Excel с опцией для пропуска определенных слов

Не удалось перезапустить макрос после удаления строки

VBA Populate Combobox с текстом

Макрос для проверки того, когда файл был изменен в последний раз

После загрузки файла excel с использованием php он дает ошибку

Телефонный номер автоматически добавляется при экспорте в файл Excel

VBA, чтобы найти совпадения между столбцом L на листе 1 и столбцом A на листе 2, затем вставьте строку, которая соответствует на листе 3

Преобразование размеров файлов с байтов в Кбайт или Mb

Объедините список файлов excel в новую книгу Excel

Окно вывода VBA / окно или подобное в Excel (2010)

Проверка данных основана на таблице

Расположить и отобразить данные, используя listbox в vba

Цитирование по столбцу, если оно имеет определенное имя

Развертывание базы данных, автоматический график и электронная почта в определенное время дня

Давайте будем гением компьютера.