열을 건너 뛰고 해당 열을 복사하지 않고 다른 열을 복사하는 방법

Question

코드가 잘 작동하는 곳에서 코드를 작성하면됩니다. 보고서를 원하지만 코드를 복사하는 동안 한 열만 제외하고 싶습니다. 한 파일에서 다른 파일로 데이터. 내 코드는 A 열에서 A 열로 복사하지만 H에서 모든 데이터를 제외하고 빈 열 H가 없도록 데이터를 I에서 H로 옮깁니다.이 도움말이 도움이 되었기를 바랍니다.

Sub Distinct() 
Const TRNS_START As String = "TRNS" 
    Const TRNS_END As String = "ENDTRNS" 
    Const COMPANY As String = "Triumph Foods LLC" 

    Dim searchRng As Range, copyRngStart As Range, copyRngEnd As Range 

    Set searchRng = Worksheets("Information").Range("A1") 

    ' Enter/continue loop while A-column is non-empty 
    Do While searchRng.Value <> "" 

     ' When we encounter the string TRNS in column A and Triumph Foods LLC in column E 
     If searchRng.Value = TRNS_START And _ 
      searchRng.Offset(0, 4).Value = COMPANY Then 

      Set copyRngStart = searchRng ' Set the start of the copy area 
     End If 

     ' When we encounter the string ENDTRNS 
     ' (*and had a start cell already*) 
     If searchRng.Value = TRNS_END And Not copyRngStart Is Nothing Then 

      Set copyRngEnd = searchRng.Offset(-1, 8) 

      copyRngEnd.Worksheet.Range(copyRngStart, copyRngEnd).Copy _ 
       Destination:=Sheets("Display").Cells(Rows.Count, "A").End(xlUp).Offset(1, 0) 

      Set copyRngStart = Nothing 'clear the "start" range 

     End If 

     Set searchRng = searchRng.Offset(1, 0) 
    Loop 


End Sub 

Answer 1

당신은 내가 VBA를 사용하여 복사의 많은 팬이 아니지만, 직접 값을 할당하는 것을 선호이

Sub Distinct() 
    Const TRNS_START As String = "TRNS" 
    Const TRNS_END As String = "ENDTRNS" 
    Const COMPANY As String = "Triumph Foods LLC" 

    Dim searchRng As Range, copyRngStart As Range, copyRngEnd As Range, copyRng As Range 
    Dim wsFrom As Worksheet 

    Set wsFrom = Worksheets("Information") 
    Set searchRng = wsFrom.Range("A1") 

    ' Enter/continue loop while A-column is non-empty 
    Do While Not IsEmpty(searchRng.Value)  
     ' When we encounter the string TRNS in column A and Triumph Foods LLC in column E 
     If searchRng.Value = TRNS_START And _ 
      searchRng.Offset(0, 4).Value = COMPANY Then 

      Set copyRngStart = searchRng ' Set the start of the copy area 
     End If 

     ' When we encounter the string ENDTRNS 
     ' (*and had a start cell already*) 
     If searchRng.Value = TRNS_END And Not copyRngStart Is Nothing Then 

      Set copyRngEnd = searchRng.Offset(-1, 6) ' A:G 

      Set copyRng = wsFrom.Range(copyRngStart, copyRngEnd) 
      ' union with I 
      Set copyRng = Application.Union(copyRng, copyRng.Columns(1).Offset(, 8))  
      copyRng.Copy _ 
       Destination:=Sheets("Display").Cells(Rows.Count, "A").End(xlUp).Offset(1, 0) 

      Set copyRngStart = Nothing 'clear the "start" range 

     End If 
     Set searchRng = searchRng.Offset(1, 0) 
    Loop 
End Sub 

Answer 2

처럼 복사하는 비 연속적인 범위를 만들 Union를 사용할 수 있습니다. 귀하의 특정 문제에 대해 나는 두 부분으로 가치의 할당을 깨는 것이 좋습니다. 당신이 당신의 코드를 대체 할 것이다 당신이 값을 복사 될 때 코드 그래서 :

Sheets("Display").Range("A" & (Sheets("Display").Columns(1).Rows.Count + 1) & ":H" & (Rows.Count + 1)).Value2 = Worksheets("Information").Range("A1:G1").Offset(copyRngStart.Row, 0) 
Sheets("Display").Range("I" & (Sheets("Display").Columns(1).Rows.Count + 1)).Value2 = Worksheets("Information").Range("H1").Offset(copyRngStart.Row, 0) 

이 직접 처음 G A에서 작성하고 나서이 당신을 위해 작동 H.Hope을 작성합니다.