Excel VBA Macro - Exclude some columns while Copying one row to other

Question

Hi,

I want to copy contents of one row in excel to other row.
Currently I am using following code for copying data from previous row.

rngCurrent.Offset(-1).Copy
rngCurrent.PasteSpecial (xlPasteValues)

But I want to skip some columns. So lets say if there are 20 columns, I want to copy all columns except column 4 and 14. How to acheive this in vba ? Any suggestions ?

Example:

Assume following is the data in row.

Row to be copied........> 1 2 3 4 5 6 7 8 .... 14 15 16  
Target Row Before Copy..> A B C D E F G H .... N  O   P
Target Row After Copy...> 1 2 3 D 5 6 7 8 .... N  15 16  

So everything is copied except column 4 and 14. Note that oringal values D and N in column 4 and 14 of Target row are preserved.

Thanks in Advance,
Sam

Answer 1

Try using union of 2 ranges Union(Range("Range1"), Range("Range2"))

Answer 2

Sam

I am not sure exactly how you want to use the macro (i.e. do you select range in sheet, or single cell?) but the following code may get you started:

EDIT - code updated to reflect your comments. I have added a function to check if the columns you want to keep are in the array.

Sub SelectiveCopy()
'Set range based on selected range in worksheet

    Dim rngCurrent As Range
    Set rngCurrent = Selection

'Define the columns you don't want to copy - here, columns 4 and 14

    Dim RemoveColsIndex As Variant
    RemoveColsIndex = Array(4, 14)

'Loop through copied range and check if column is in array

Dim iArray As Long
Dim iCell As Long

For iCell = 1 To rngCurrent.Cells.Count
    If Not IsInArray(RemoveColsIndex, iCell) Then
        rngCurrent.Cells(iCell).Value = rngCurrent.Cells(iCell).Offset(-1, 0)
    End If
Next iCell

End Sub

Function IsInArray(MyArr As Variant, valueToCheck As Long) As Boolean
Dim iArray As Long

    For iArray = LBound(MyArr) To UBound(MyArr)
        If valueToCheck = MyArr(iArray) Then
            IsInArray = True
            Exit Function
        End If
    Next iArray

InArray = False
End Function

Depending on what you want to do you could augment this code. For example, rather then selecting the range you want to copy, you could click any cell in the row and then use the following to select the EntireRow and then perform the copy operation:

Set rngCurrent = Selection.EntireRow

Hope this helps

Answer 3

Another way of doing it.....takes less no. of loops.

Assumptions
1. Skip columns are in ascending order.
2. Skip columns value starts from 1 and not 0.
3. Range("Source") is First cell in source data.
4. Range("Target") is First cell in target data.

Sub SelectiveCopy(rngSource As Range, rngTarget As Range, intTotalColumns As Integer, skipColumnsArray As Variant)

If UBound(skipColumnsArray) = -1 Then
    rngSource.Resize(1, intTotalColumns).Copy
    rngTarget.PasteSpecial (xlPasteValues)
Else

    Dim skipColumn As Variant
    Dim currentColumn As Integer

    currentColumn = 0

    For Each skipColumn In skipColumnsArray
        If skipColumn - currentColumn > 1 Then 'Number of colums to copy is Nonzero.'
            rngSource.Offset(0, currentColumn).Resize(1, skipColumn - currentColumn - 1).Copy
            rngTarget.Offset(0, currentColumn).PasteSpecial (xlPasteValues)
        End If

        currentColumn = skipColumn
    Next

    If intTotalColumns - currentColumn > 0 Then
        rngSource.Offset(0, currentColumn).Resize(1, intTotalColumns - currentColumn).Copy
        rngTarget.Offset(0, currentColumn).PasteSpecial (xlPasteValues)
    End If

End If

Application.CutCopyMode = False

End Sub

How to call :

SelectiveCopy Range("Source"), Range("Target"), 20, Array(1)     'Skip 1st column'
SelectiveCopy Range("Source"), Range("Target"), 20, Array(4,5,6) 'Skip 4,5,6th column'
SelectiveCopy Range("Source"), Range("Target"), 20, Array()      'Dont skip any column. Copy all.

Thanks.