У мене є макрос, який копіює весь аркуш 2 на аркуш 1 на основі заголовків.

Наприклад,

Аркуш 2 має кілька стовпців, а аркуш 1 матиме лише 5 або 6 стовпців із заголовками аркуша 2. За допомогою сценарію нижче аркуш 1 витягне весь рядок; на основі заголовків Аркуша 2 (Приклад: 10). Тепер мені потрібно дещо змінити сценарій, щоб він отримував лише виділені (червоним) рядки з аркуша 2 на основі заголовків (наприклад, 2 рядки). Будь ласка, допоможіть.

Підмакрос1()
Dim Rng As Range, c As Range
Dim sCell As Range
Dim rSize As Long
Dim dest As Range
Dim headerRng As Range
Dim lDestRow As Long
Dim i як ціле число
Application.ScreenUpdating = False 'Розкоментуйте після тестування

Аркуші("Базовий аркуш").Вибер
я = 0
Установіть Rng = Range([D1], [D1].End(xlToRight))


Для кожного c In Rng


Установіть sCell = Sheets("Roster").Range("1:1").Find(what:=c.Value, LookIn:=xlValues, lookat:=xlWhole)
rSize = Sheets("Roster").Range(sCell.Offset(1, 0), sCell.End(xlDown)).SpecialCells(xlCellTypeVisible).Cells.Count

Якщо c.Offset(1, 0).Value <> "" Тоді
'c.End(xlDown).Offset(1, 0).Resize(rSize, 1) = Sheets("Roster").Range(sCell.Offset(1, 0), sCell.End(xlDown)).SpecialCells( xlCellTypeVisible).Значення
Установити dest = c.End(xlDown).Offset(1, 0)
Якщо i = 0 Тоді
lDestRow = dest.Row
End If

Якщо dest.Row < lDestRow Then
Установити dest = Cells(lDestRow, dest.Column)
End If

Аркуші("Список").Діапазон(sCell.Offset(1, 0), sCell.End(xlDown)).SpecialCells(xlCellTypeVisible).Копіювати
dest.Select
ActiveSheet.Paste


Ще
'c.Offset(1, 0).Resize(rSize, 1).Value = Range(sCell.Offset(1, 0), sCell.End(xlDown)).SpecialCells(xlCellTypeVisible).Value

Діапазон (sCell.Offset(1, 0), sCell.End(xlDown)).SpecialCells(xlCellTypeVisible).Копіювати
Установити dest = c.Offset(1, 0)

Якщо dest.Row < lDestRow Then
Установити dest = Cells(lDestRow, dest.Column)
End If

dest.Select
ActiveSheet.Paste
End If

i = i + 1
МАЙБУТНІ
Application.ScreenUpdating = True

End Sub