CODEWITHSUNDEEP
excelvba
Swiftslide
Swiftslide

Reputation: 1347

Excel VBA: Copying certain noncontiguous cells from a worksheet row into a row of another worksheet

I have a worksheet where each row (except the header) represents a single entry, each column a field (pretty standard stuff). The fields go up to column BB.

I want to copy certain entries (those matching a particular value for a particular identifying field) onto another sheet. However, I don't want all the fields that are on the original sheet, only about 10, which aren't contiguous on the original sheet.

Therefore, for each (valid) row, I would want to do something like this:

for each origRow in origSheet.Rows
    if strcomp(origRow.cells(idCellNumber).value, myId, vbTextCompare) = 0 then
        copySheet.Row(copySheetRowNumber).value = origRow.Range(Cells(1), Cells(8), Cells(15), Cells(4))
        copySheetRowNumber++
    end if
next

Obviously this code is invalid. Furthermore, I can't simply copy the entries as a whole and then delete the irrelevant columns, since the sheet contains existing data which would be deleted. Can anyone suggest the fastest way to accomplish this?

Upvotes: 0

Views: 1234

Answers (1)

Tim Williams
Tim Williams

Reputation: 166196

Dim arrSourceCols, arrDestCols
Dim x As Long

arrSourceCols = Array(1, 3, 5, 7)
arrDestCols = Array(2, 4, 8, 12)

For Each origRow In origSheet.UsedRange.Rows
    If StrComp(origRow.Cells(idCellNumber).Value, myId, vbTextCompare) = 0 Then

        For x = LBound(arrSourceCols) To UBound(arrSourceCols)
            copySheet.Cells(copySheetRowNumber, arrDestCols(x)).Value = _
                                  origRow.EntireRow.Cells(arrSourceCols(x)).Value
        Next x

        copySheetRowNumber = copySheetRowNumber + 1
    End If
Next

Upvotes: 2

Related Questions