특정 통합 문서를 다른 통합 문서로 복사

Question

vba로 특정 행을 복사하는 데 문제가 있습니다. 여기

내 코드 : 그래서

Dim color1 As Integer 
Dim color2 As Integer 
Dim lines As Integer 

Workbooks.Open Filename:="D:\01 January.xlsm", _ 
    UpdateLinks:=0 
lines = WorksheetFunction.CountA(Range("U:U")) - 1 


Dim i As Integer 
For i = 6 To lines + 6 

color1 = Cells(i, 21).Value 
color2 = Cells(i, 22).Value 

    If IsNumeric(Cells(i, 21)) Then 

     Select Case color1 & color2 
      Case Evaluate("=White") & Evaluate("=Blue") 
       Rows(i & ":" & i).Select 

      Case Evaluate("=Yellow") & Evaluate("=Yellow") 
       Rows(i & ":" & i).Select 

      Case Evaluate("=Yellow") & Evaluate("=Green") 
       Rows(i & ":" & i).Select 

     End Select 

    End If 
Next i 

    Selection.Copy 

    Windows("Test.xlsm").Activate 

    Rows("11:11").Select 

    Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _ 
     SkipBlanks:=False, Transpose:=False 
    Selection.PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, _ 
     SkipBlanks:=False, Transpose:=False 

End Sub 

당신이 볼 수있는 바와 같이, 나는 January.xlsm의 기준을 충족하는 행을 선택하고 test.xlsm

에 나중에 붙여 넣을 것을 시도하고있다 현재는 마지막으로 선택한 행만 붙여 넣기 만하고 모든 행을 붙여 넣지는 않습니다.

저는 VBA를 처음 접했기 때문에 여러분의 도움이 필요합니다. 내가 생각한 것은 배열에 필요한 모든 행을 넣은 다음 다른 통합 문서로 복사하는 것입니다. 하지만 그게 좋을지 아니면 그냥 문지르면 그게 효과가 있을지 모르겠다. 나는 해결책을 찾지 못한다 ...

당신의 모든 도움에 감사드립니다!

Answer 1

마지막 행만 붙여 넣기하는 이유는 개별 행을 선택하지만 아무 것도 수행하지 않기 때문입니다. 수정 된 코드를 참조하십시오. case 문에서 중복 선택을 제거하고 워크 시트에 한 번만 붙여 넣을 수 있도록 범위/조합 조합을 제공하여 사용자 지정 범위를 만들었습니다.

Dim color1 As Integer 
Dim color2 As Integer 
Dim lines As Integer 

Workbooks.Open Filename:="D:\01 January.xlsm", _ 
    UpdateLinks:=0 
lines = WorksheetFunction.CountA(Range("U:U")) - 1 


Dim i As Integer 
Dim rngUnion As Range 
Dim booCopy As Boolean 
For i = 6 To lines + 6 
    booCopy = True 
    color1 = Cells(i, 21).Value 
    color2 = Cells(i, 22).Value 

    If IsNumeric(Cells(i, 21)) Then 

     Select Case color1 & color2 
      Case Evaluate("=White") & Evaluate("=Blue") 
      Case Evaluate("=Yellow") & Evaluate("=Yellow") 
      Case Evaluate("=Yellow") & Evaluate("=Green") 
      Case Else 
       booCopy = False 
     End Select 

    End If 
    If booCopy = True Then 
     If rngUnion Is Nothing Then 
      Set rngUnion = Rows(i & ":" & i) 
     Else 
      Set rngUnion = Union(rngUnion, Rows(i & ":" & i)) 
     End If 
    End If 

Next i 
If Not rngUnion Is Nothing Then 
    rngUnion.Copy 
    Windows("Test.xlsm").Activate 
    With Rows("11:11") 
     .PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _ 
      SkipBlanks:=False, Transpose:=False 
     .PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, _ 
      SkipBlanks:=False, Transpose:=False 
    End With 
    Application.CutCopyMode = False 
End If 
End Sub 

Answer 2

마지막으로 선택한 행만 붙여 넣기하는 이유는 루프 내에서 복사하여 붙여 넣기를하지 않기 때문입니다. 루프 내에서 Selection.Copy/Paste을 이동하면 코드가 작동합니다. 이렇게하는 더 좋은 방법은 복사 및 붙여 넣기를 완전히 피하고 행의 값을 직접 설정하지 않는 것입니다.

Dim i As Integer 
For i = 6 To lines + 6 

color1 = Cells(i, 21).Value 
color2 = Cells(i, 22).Value 

    If IsNumeric(Cells(i, 21)) Then 

     Select Case color1 & color2 
      Case Evaluate("=White") & Evaluate("=Blue"): 
       Workbooks("Test").Sheets("Sheet1").Rows(i).Value = _ 
        Workbooks("01 January").Sheets("Sheet1").Rows(i).Value 
      ... 
    End Select 

End If 
Next i 

당신은 단지 필요에 따라 시트 또는 통합 문서 이름을 업데이트 할 수 있지만이 방법은 실질적으로 빠른 복사 및 붙여 넣기보다 아래 코드를 참조하십시오.

Answer 3

당신이 행 큰 번호를 복사해야하고 어느 Union()도 Address() 방법에 의존 먼저 복사에 대한 행을 표시 할 수있는 "도우미"열로 전환하고 복사 할 수 없습니다 더 안전 붙여 넣기해야하며, 한 번에 붙여 넣기. 이것은 또한 전용 "숫자"세포를 필터링 할 SpecialCells() 방법을 활용할 수도

위의 두 방법 다음 훨씬 빠릅니다 :

Dim lines As Long 
Dim cell As Range 

Workbooks.Open Filename:="D:\01 January.xlsm", UpdateLinks:=0 
lines = WorksheetFunction.CountA(Range("U:U")) - 1 
With Range(Cells(6, "U"), Cells(lines + 6, "U")) '<--| reference your relevant range in column "U" 
    For Each cell In .SpecialCells(xlCellTypeConstants, xlNumbers) '<--| loop through "numeric" cells only 
     Select Case cell.Value & cell.Offset(, 1).Value 
      Case Evaluate("=White") & Evaluate("=Blue"), Evaluate("=Yellow") & Evaluate("=Yellow"), Evaluate("=Yellow") & Evaluate("=Green") 
       cell.Offset(, 2).Value = 1 '<--| mark row for copying&pasting 
     End Select 
    Next 
    With .Offset(, 2) '<-- consider column "W" cells corresponding to referenced cells 
     If WorksheetFunction.CountA(.Cells) > 0 Then '<--| if there's at least one row marked for copy&paste 
      .SpecialCells(xlCellTypeConstants, xlNumbers).EntireRow.Copy '<--| copy all marked rows 
      With Workbooks("Test.xlsm").ActiveSheet.Rows("11:11") '<--| reference target range 
       .PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _ 
           SkipBlanks:=False, Transpose:=False 
       .PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, _ 
           SkipBlanks:=False, Transpose:=False 
      End With 
      Application.CutCopyMode = False '<--| clear clipboard 
     End If 
     .ClearContents '<--| clear "helper" column 
    End With 
End With