Exclude some columns while copying one row to other

后端 未结 3 651
孤街浪徒
孤街浪徒 2020-12-21 15:28

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         


        
相关标签:
3条回答
  • 2020-12-21 15:43

    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.

    0 讨论(0)
  • 2020-12-21 15:55

    Try using union of 2 ranges:

    Union(Range("Range1"), Range("Range2"))
    
    0 讨论(0)
  • 2020-12-21 15:58

    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

    0 讨论(0)
提交回复
热议问题