vba 将一行复制到另一行时排除一些列

Exclude some columns while copying one row to other

提问by Sambhaji

I want to copy contents of one row in Excel to other row.

我想将 Excel 中一行的内容复制到另一行。

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 let's say if there are 20 columns, I want to copy all columns except column 4 and 14. How can this be achieved in VBA?

但我想跳过一些列。因此，假设有 20 列，我想复制除第 4 列和第 14 列之外的所有列。如何在 VBA 中实现这一点？

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 original values D and N in column 4 and 14 of Target row are preserved.

因此，除了第 4 列和第 14 列之外的所有内容都被复制。请注意，保留目标行第 4 和 14 列中的原始值 D 和 N。

采纳答案by Alex P

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 EntireRowand then perform the copy operation:

根据您想要做什么，您可以扩充此代码。例如，与其选择要复制的范围，不如单击行中的任意单元格，然后使用以下命令选择EntireRow并执行复制操作：

Set rngCurrent = Selection.EntireRow

Hope this helps

希望这可以帮助

回答by anon

Try using union of 2 ranges:

尝试使用 2 个范围的并集：

Union(Range("Range1"), Range("Range2"))

回答by Sambhaji

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.

假设
1. 跳过列按升序排列。
2. 跳过列值从 1 开始而不是 0。
3. Range("Source") 是源数据中的第一个单元格。
4. Range("Target") 是目标数据中的第一个单元格。

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.

谢谢。