한 행을 다른 행에 복사하는 동안 일부 열을 제외하십시오.

Question

Excel의 한 행의 내용을 다른 행에 복사하려고합니다.

현재 이전 행의 데이터를 복사하는 데 다음 코드를 사용하고 있습니다.

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

그러나 일부 열을 건너 뛰고 싶습니다. 예를 들어 열이 20 개인 경우 4 열 및 14 열을 제외한 모든 열을 복사하려고합니다. VBA에서는 어떻게 이러한 결과를 얻을 수 있습니까?

예 :

이 가정은 다음 행의 데이터이다.

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 

그래서 모든 칼럼 (4) 원래 값 D 및 N 컬럼의 4 행의 대상 (14)이 유지되는 것을 제외하고 14 주 복사된다. 이 개 범위의

Answer 1

샘

난 당신이 (? 즉, 당신이 시트의 범위, 또는 단일 셀을 선택 함) 매크로를 사용하려면 정확히 모르겠지만 다음 코드를 사용해보십시오.

수정 - 귀하의 의견을 반영하도록 코드가 업데이트되었습니다. 유지할 열이 배열에 있는지 확인하는 함수를 추가했습니다.

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 

원하는대로이 코드를 보완 할 수 있습니다. 예를 들어, 오히려 다음 복사 할 범위를 선택, 당신은 행의 셀을 클릭 한 다음 EntireRow을 선택하려면 다음을 사용하고 복사 작업을 수행 할 수 있습니다 :

Set rngCurrent = Selection.EntireRow 

는 희망이

Answer 2

시도하여 조합 :

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

Answer 3

도움을

그것을하는 또 다른 방법 ..... 덜 노름. of 루프.

가정
1 스킵 열은 오름차순이다.
2. 범위 건너 뛰기 값은 0이 아닌 1에서 시작합니다.
3. 범위 ("원본")는 원본 데이터의 첫 번째 셀입니다.
4. 범위 ("대상")는 대상 데이터의 첫 번째 셀입니다.

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 

를 호출하는 방법 :

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. 

감사합니다.