VBA - Copying part of a row to matching column headers

[NathanA]

I have code to copy rows of data to another sheet if the cell in column L equals "High" or "Extreme". I'm unsure how to copy only certain columns of that row to the new spreadsheet, which has matching headers in place. I'd like to either copy columns 2, 3, 6, 12, 14, 18, and 21, or have the code copy the columns which match the column headers in the new sheet. Any guidance would be much appreciated!

Sub Copy()
     'assuming the data is in Current Risks
Set i = Sheets("Current Risks")
Set e = Sheets("Extreme&High Risk Report")
Dim d
Dim j
d = 1
j = 2


Do Until IsEmpty(i.Range("L" & j))
'copy row with high or extreme risk rating
If i.Range("L" & j) = "Extreme" Or i.Range("L" & j) = "High" Then
d = d + 1
e.Rows(d).Value = i.Rows(j).Value


End If
j = j + 1
Loop


End Sub

 

[Warship]

NOT tested but I think this right:

Sub Copy()
     'assuming the data is in Current Risks
    Set i = Sheets("Current Risks")
    Set e = Sheets("Extreme&High Risk Report")
    Dim d
    Dim j
    d = 1
    j = 2
    Do Until IsEmpty(i.Range("L" & j))
        'copy row with high or extreme risk rating
        If i.Range("L" & j) = "Extreme" Or i.Range("L" & j) = "High" Then
            d = d + 1
'            e.Rows(d).Value = i.Rows(j).Value
'            2, 3, 6, 12, 14, 18, and 21
            e.Cells(d, 1).Value = i.Cells(j, 2).Value
            e.Cells(d, 2).Value = i.Cells(j, 3).Value
            e.Cells(d, 3).Value = i.Cells(j, 6).Value
            e.Cells(d, 4).Value = i.Cells(j, 12).Value
            e.Cells(d, 5).Value = i.Cells(j, 14).Value
            e.Cells(d, 6).Value = i.Cells(j, 18).Value
            e.Cells(d, 7).Value = i.Cells(j, 21).Value
        End If
        j = j + 1
    Loop
End Sub

 

[NathanA]

Thanks for your time, it works perfectly!

 

[Warship]

my pleasure!