불연속 범위의 결합을 복사하여 다른 시트에 붙여 넣는 방법은 무엇입니까?

Question

나는 엑셀의 형태는 다음과 같습니다있어 : 그것은 합계와 많은 작은 영역으로 구성

E F G H ... N O P Q 
    * * *  * * * 
    * * *  * * * 
       * * * 
       * * * 
       * * * 
T:* * * T:* * * 

    * * *  * * * 
    * * *  * * * 
    * * * 
    * * * 

T:* * * T:* * * 

    * * * 
    * * * 



T:* * * 

- 행 "T"로 표시.

열 E는 "가격"이고 "F"는 수량이며, 나머지는 수식 계산식이거나 비어 있습니다. 그래서 "E"에서 데이터를 수집하는 함수를 작성했습니다.이 함수는 처음에 내가 원했던 것입니다.

하지만 이제 "E"가 유효성을 검사 할 때도 "F"와 "H"에서 데이터를 가져오고 싶었습니다.

내 코드이었다

Private Function CollectCellsData(dataRange As Range) As Range 
Dim cell As Range, newRange As Range 

For Each cell In dataRange 

    If Not cell.HasFormula = True And Not IsEmpty(cell.Value) Then 
     If newRange Is Nothing Then 
      Set newRange = cell 
     Else 
      Set newRange = Union(newRange, cell) 
     End If 
    End If 
Next 
Set CollectCellsData = newRange 

End Function 

Private Function CopyDataAndPaste(sSheet As Worksheet, sColumn As String, dSheet As Worksheet, dColumn As String) 
Dim lastRow As Long 
Dim dataRange As Range, newRange As Range 

lastRow = sSheet.Cells(Rows.Count, sColumn).End(xlUp).Row 
Set dataRange = sSheet.Range(sColumn & "3:" & sColumn & lastRow) 
Set newRange = CollectCellsData(dataRange) 

lastRow = dSheet.Cells(Rows.Count, dColumn).End(xlUp).Row 
If Not newRange Is Nothing Then 
    newRange.Copy 
    dSheet.Range(dColumn & lastRow + 1).PasteSpecial Paste:=xlPasteValues 
    Application.CutCopyMode = False 
End If 

End Function 

그리고 단순히 대체했다 할 수있는 가장 간단한 방법 생각 :

Set newRange = Union(newRange, cell) 

로 :

Set newRange = Union(newRange, cell, cell.Offset(0,1), cell.Offset(0,3)) 

을하지만 분명히 내가 잘못했다 . 오류 메시지는

"Error 1004: Command cannot be used on multiple selection" 

나는 개념상의 실수를했다고 생각합니다. 그러나

Union(range1, range2, range3) 

이 내 경우에는 왜 작동하지 않습니까?

편집 :

내 나쁜, 내가

Set newRange = Union(newRange, cell, cell.Offset(0,1), cell.Offset(0,3)) 

에 코드를 변경 한 후 거기에 오류가 의 강조 Chrismas007 그 후 라인

newRange.Copy 

에서 발생 연합 () 메소드가 작동해야하고, msgbox rng.address에 대한 힌트가 있어야 디버깅을 할 수 있습니다. 문제는 "newRange"할당이 아니라 두 번째 할당이 아니라 초기 할당입니다. 게리의 학생이 암시하는 것과 같이 Union은 균일 한 방식으로 세포를 수집합니다.

'error 
Set newRange = cell 

'run 
Set newRange = Union(cell, cell.Offset(0, 1), cell.Offset(0, 3)) 

몇 년 동안 프로그램을 삭제했는데 이제는 10 년 전에 초보자가되었습니다!

Answer 1

여러 선택 항목이있는 범위를 복사하는 경우 여러 선택 항목이있는 범위에 붙여 넣을 수 없습니다. 따라서 붙여 넣기 범위를 ONE CELL (범위의 왼쪽 상단에있는 셀)로 설정하여 오류를 제거해야합니다.

테스트 코드 :

Sub TestIt() 

    Dim Rng As Range 

    Set Rng = Union(Range("A1"), Range("B1"), Range("D1")) 

    Rng.Copy 

    'This code will error: 
     Rng.Offset(1, 0).PasteSpecial xlPasteValues 
    'This code will run: 
     Range("A2").PasteSpecial xlPasteValues 

    MsgBox Rng.Address 

End Sub 

Answer 2

연합()를 통해 분리 된 셀 범위를 구축하고 다른 하나의 통합 문서, 에서 그 범위를 복사 할 정말 좋은 것입니다하지만 Excel에서 그을 지원하지 않습니다

은 G에게, 우리는 열 E, F에 채워진 세포에 관심이

말해

그러나 빈 셀은 아닙니다. 여기에 dijoint 범위를 만든 다음 셀 단위로 복사합니다.

Sub CopyDisjoint() 
    Dim rBig As Range, rToCopy As Range, ady As String 
    Dim sh1 As Worksheet, sh2 As Worksheet 
    Dim r As Range 
    Set sh1 = Sheets("Sheet1") 
    Set sh2 = Sheets("Sheet2") 
    Set rBig = sh1.Range("E:H") 
    Set rToCopy = Intersect(rBig, sh1.Cells.SpecialCells(xlCellTypeConstants)) 

    For Each r In rToCopy 
     ady = r.Address 
     r.Copy sh2.Range(ady) 
    Next r 
End Sub