2016-12-19 2 views
0

셀 값의 기준에 따라 한 시트에서 다른 시트로 행을 이동합니다. 셀 값이 충족되면 다른 시트로 이동합니다. 그러나 그것이 움직일 때, 나는 그것이 가치로서 움직일 필요가있다. 내 셀 중 하나에 공식이 있고 그 셀의 값을 새 시트에 넣기 만하면됩니다. 아래는 행을 움직이는 코드의 일부입니다. 내 질문은 PasteSpecial 또는 해당 코드를 값으로 이동하기 위해 어디에서 추가합니까? 감사!VBA- 값으로 다른 시트의 행을 복사하여 붙여 넣기

For Each xCell In xRg 
    If CStr(xCell.Value) = "Pipeline" Then 
     xCell.EntireRow.Copy Destination:=Worksheets("Pipeline2").Range("A" & B + 1) 
     xCell.EntireRow.Delete 
     B = B + 1 

답변

1

값을 원하면 범위를 서로 동일하게 설정할 수 있습니다.

For Each xCell In xRg 
    If CStr(xCell.Value) = "Pipeline" Then 
     Worksheets("Pipeline2").Range("A" & B + 1).EntireRow.Value = xCell.EntireRow.Value 

     xCell.EntireRow.Delete 
     B = B + 1 

편집 : 당신이 필요로하는 최소에 실제로 복사 범위 값을 제한 할 수 있습니다 "배트맨"솔루션, 또한 형식

For Each xCell In xRg 
    If CStr(xCell.Value) = "Pipeline" Then 
     Worksheets("Pipeline2").Range("A" & B + 1).EntireRow.Value = xCell.EntireRow.Value 
     xCell.EntireRow.Copy 
     Worksheets("Pipeline2").Range("A" & B + 1).EntireRow.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _ 
      SkipBlanks:=False, Transpose:=False 
     Application.CutCopyMode = False 
     xCell.EntireRow.Delete 
     B = B + 1 
+0

이 방법은 작동했지만 서식이 없어졌습니다 (각 셀 주위에 테두리가 있음). 아직도 그걸 지킬 방법이 있니? 감사! – gluc7

+0

@ gluc7 - 편집을 참조하십시오. – BruceWayne

0
난 당신이 .. 돌아가 다음, 다음 pastespecial 다음, 복사,이 같은 원래의 워크 시트를 선언해야 할 수 있습니다 (이상입니다)하지만, 믿지 않는

:

'...... 
Set ws1 = Activeworksheet 
    For Each xCell In xRg 
    If CStr(xCell.Value) = "Pipeline" Then 
     xCell.EntireRow.Copy Destination:=Sheets("Pipeline2").Range("A" & B + 1) 
     Sheets("Pipeline2").Activate 
     Sheets("Pipeline2").Range("A" & B + 1).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False 
     Application.CutCopyMode = False 
     ws1.astivate 
     xCell.EntireRow.Delete 
     B = B + 1 
0

건물을 유지하기 위해 (1 열에서하지 지속하는 즉, 해당 행의 빈 셀) :

For Each xCell In xRg 
    If CStr(xCell.Value) = "Pipeline" Then 
     With xCell.Parent 
      With .Range(.Cells(xCell.row, 1), .Cells(xCell.row, .Columns.count).End(xlToLeft)) 
       Worksheets("Pipeline2").Range("A" & B + 1).Resize(.Columns.count).Value = .Value 
      End With 
     End With 
     xCell.EntireRow.Delete 
     B = B + 1 
+0

그래도 그 빈 셀에는 포맷팅이되어 있습니다. Thats는 매우 유용하지만이 경우 각 시트에서 균일하게 보이게해야합니다. 최소 요구 사항을 사용하려면 빈 셀에 대한 서식 중 일부가 이월되지 않습니다. 적어도 그것이 내 머리 속에서 어떻게 작동하는지 생각합니다. 틀 렸으면 고쳐줘. – gluc7

+0

당신은 맞습니다. 그러나 특별히 질문에 "가치"가있는 동안 서식을 언급하지 않은 질문에 대한 나의 대답을 조정했습니다. – user3598756

0

이와 비슷한 것이 당신을 위해해야합니다.

Sub copy_paste() 
    Dim i As Integer 

    i = 2 

    Sheets("Sheet1").Select 
    Range("E2").Select 

    Do While ActiveCell <> "" 
     If Range("E" & ActiveCell.Row) <> "" And Range("F" & ActiveCell.Row) <> "" Then 
      Range("E" & ActiveCell.Row).Copy Sheets(Sheet3).Range("B" & i) 
      Range("F" & ActiveCell.Row).Copy Sheets(Sheet3).Range("E" & i) 
      Range("A" & ActiveCell.Row).Copy Sheets(Sheet3).Range("F" & i) 
      Range("H" & ActiveCell.Row).Copy Sheets(Sheet3).Range("G" & i) 
      Range("I" & ActiveCell.Row).Copy Sheets(Sheet3).Range("H" & i) 
      Range("K" & ActiveCell.Row).Copy Sheets(Sheet3).Range("I" & i) 
      i = i + 1 
     End If 
     ActiveCell.Offset(1, 0).Select 
    Loop 

End Sub 
관련 문제