특정 조건으로 새 시트에 행 잘라 내기/붙여 넣기

Question

특정 기준에 따라 행을 새 시트로 이동해야합니다. 여기에서 매우 도움이되는 토론을 찾았지만 거의 정확히 필요한 부분이지만 행을 마스터 시트에서 삭제해야합니다. 나는이 매우 새로운 오전 같은 통찰력, 도움이 될 것

Option Explicit 

Sub Fr33M4cro() 

Dim sh33tName As String 
Dim custNameColumn As String 
Dim i As Long 
Dim stRow As Long 
Dim customer As String 
Dim ws As Worksheet 
Dim sheetExist As Boolean 
Dim sh As Worksheet 

sh33tName = "Sheet1" 
custNameColumn = "I" 
stRow = 2 

Set sh = Sheets(sh33tName) 

For i = stRow To sh.Range(custNameColumn & Rows.Count).End(xlUp).Row 
    customer = sh.Range(custNameColumn & i).Value 
    For Each ws In ThisWorkbook.Sheets 
     If StrComp(ws.Name, customer, vbTextCompare) = 0 Then 
      sheetExist = True 
      Exit For 
     End If 
    Next 
    If sheetExist Then 
     CopyRow i, sh, ws, custNameColumn 
    Else 
     InsertSheet customer 
     Set ws = Sheets(Worksheets.Count) 
     CopyRow i, sh, ws, custNameColumn 
    End If 
    Reset sheetExist 
Next i 

End Sub 

Private Sub CopyRow(i As Long, ByRef sh As Worksheet, ByRef ws As Worksheet, custNameColumn As String) 
Dim wsRow As Long 
wsRow = ws.Range(custNameColumn & Rows.Count).End(xlUp).Row + 1 
sh.Rows(i & ":" & i).Copy 
ws.Rows(wsRow & ":" & wsRow).PasteSpecial _ 
Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False 
Application.CutCopyMode = False 
End Sub 

Private Sub Reset(ByRef x As Boolean) 
x = False 
End Sub 

Private Sub InsertSheet(shName As String) 
Worksheets.Add(After:=Worksheets(Worksheets.Count)).Name = shName 
End Sub 

: 내가 사용하고 코드는 다음입니다. 감사!

Answer 1

이 시도 :

Private Sub CopyRow(i As Long, ByRef sh As Worksheet, ByRef ws As Worksheet, custNameColumn As String) 
Dim wsRow As Long 
wsRow = ws.Range(custNameColumn & ws.Rows.Count).End(xlUp).Row + 1 

ws.Rows(wsRow).EntireRow.Value = sh.Rows(i).EntireRow.Value 
sh.Rows(i).EntireRow.Delete 
End Sub 

참고하십시오 ws.을 Rows.Count 앞에. 또한 값만 원하기 때문에 범위를 서로 동일하게 설정할 수 있습니다. 이렇게하면 클립 보드를 사용하지 않고 조금 더 빠릅니다.

참고 :이 하위를 호출하는 루프에서 행을 삭제하는거야 때문에, 나는 끝에서 시작하는 것이 좋습니다 상단을 향해 길을 작업 :

For i = sh.Range(custNameColumn & sh.Rows.Count).End(xlUp).Row to stRow Step -1

그 작동해야합니다. 그렇지 않은 경우 을 CopyRow 하위 끝에 추가하고 i을 전역으로 설정합니다.

만 열은 A-M (~ 13 일), 당신이 할 것입니다하려는 경우

는 :

ws.Range(ws.cells(i,1),ws.cells(i,13)).Value = sh.Range(sh.Cells(i,1),sh.Cells(i,13)).Value

(I 거꾸로이있을 수 있습니다, 또는 i은 전환, 그러나 당신은 생각을해야한다).