Код Excel VBA, необходимый для копирования строки, если выполнены критерии

Question

У меня есть документ Excel с двумя листами. В листе 1 имеются столбцы A-Q, а на листе 2 - столбцы A-H. Мне нужен код, который скопирует информацию в строке от листа 1 до листа 2, если критерии будут выполнены. Критерии - это слово «Награжден» в столбце L (лист 1). Также возможно ли копировать только определенные столбцы в строке?

A B C D E F G H I J K L  M N 
      X X         Awarded X X 

Я хотел бы иметь только столбцы C, D, M и N копируется из строки, если слово «присвоено» в колонке L. Этой информация будет скопирована на лист 2 следующим образом

Sheet 1  Sheet 2 
D  --> B 
C  --> C 
M  --> D 
N  --> F 

Надеюсь, я все ясно. Спасибо заранее и дайте мне знать, если мне нужно уточнить! +

Это код, который у меня есть сейчас, который работает. Единственная проблема заключается в том, что он копирует всю строку информации в лист 2, когда мне нужно только скопировать строки D, C, M и N.

Sub testing() 
Set a = Sheets("Sheet1") 
Set b = Sheets("Sheet2") 
Dim d 
Dim j 
d = 1 
j = 2 

Do Until IsEmpty(a.Range("L" & j)) 



If a.Range("L" & j) = "Awarded" Then 
d = d + 1 
b.Rows(d).Value = a.Rows(j).Value 

End If 
j = j + 1 

Loop 
End Sub 

Answer 1

Прежде всего, вам нужно изменить структуру данных. Предполагая, что вы используете Excel 2007 или новее, есть замечательная функция, называемая таблицами. Если вы выделите все свои данные и перейдите в «Вставка-> Таблица», установите флажок «Моя таблица с заголовками» и нажмите «ОК», вы увидите красиво отформатированную таблицу. Сделайте это для обоих наборов данных на каждом листе.

Это не просто красивое форматирование, а то, что называется ListObject. В коде VBA, используйте следующее для ссылки на него:

Dim Table1 as ListObject, Table 2 as ListObject 
Dim HeaderIndex as Integer 
Dim MyColumnRange as Range 

Set Table1 = Sheet1.ListObjects("TableName1") 
    `Change the table name under Formulas->Name Manager 
Set Table2 = Sheet1.ListObjects("TableName2") 

HeaderIndex = Application.WorksheetFunction.Match("ColumnLHeaderName", _ 
    Table1.HeaderRowRange, 0) 
Set MyColumnRange = Table1.ListColumns(HeaderIndex).DataBodyRange 
MyColumnRange.Select 

В этот момент оператор выбора просто показать вам, что в диапазоне вы имеете дело с компанией. Заголовок HeaderIndex относится к суб-компоненту заголовка таблицы ListObject. Использование Match() позволит вам указать имя заголовка столбца без жесткого кодирования его позиции. (т. е. если ваши данные начинаются в столбце A, значение заголовка в столбце L вернет HeaderIndex = 12)

Теперь, когда вы знаете, какой столбец вы хотите, вы выбираете объект ListColumn. Затем DataBodyRange используется для выбора компонента диапазона этого объекта. Это весь диапазон в этом столбце. Затем вы можете перебрать список, чтобы найти нужные данные.

EDIT: Обновленный Пример:

'Specify your ranges you will be copying from beforehand, adding as many as you need here. 
HeaderIndex_D = Application.WorksheetFunction.Match("ColumnXHeaderName", _ 
    Table1.HeaderRowRange, 0) 
HeaderIndex_C = Application.WorksheetFunction.Match("ColumnXHeaderName", _ 
    Table1.HeaderRowRange, 0) 
HeaderIndex_M = Application.WorksheetFunction.Match("ColumnXHeaderName", _ 
    Table1.HeaderRowRange, 0) 
HeaderIndex_N = Application.WorksheetFunction.Match("ColumnXHeaderName", _ 
    Table1.HeaderRowRange, 0) 
Set ColumnRange_D= Table1.ListColumns(HeaderIndex_D).DataBodyRange 
Set ColumnRange_C= Table1.ListColumns(HeaderIndex_C).DataBodyRange 
Set ColumnRange_M= Table1.ListColumns(HeaderIndex_M).DataBodyRange 
Set ColumnRange_N= Table1.ListColumns(HeaderIndex_N).DataBodyRange 


'Now, loop through each row that exists in your table. If the testing 
'condition contained in MyColumnRange you previously defined is met, 
'then assign the destination cell (which can be defined in the same way 
'as above) equal to the lookup range's current row value (specified by i) 
For i = 1 to MyColumnRange.Rows.Count 
    If MyColumnRange(i) = "Awarded" Then 
     DestinationCell1.Value = ColumnRange_D(i) 
     DestinationCell2.Value = ColumnRange_C(i) 
     DestinationCell3.Value = ColumnRange_M(i) 
     DestinationCell4.Value = ColumnRange_N(i) 
    End If 
Next i