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.Offse
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.
Try using union of 2 ranges:
Union(Range("Range1"), Range("Range2"))
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