特定の条件で新しいシートに行をカット/ペーストする

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 

私はこのことにとても慣れているので、どんな洞察も役に立ちます。ありがとう！

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 

注：Rows.Countの前でws.

Answer 1

はこれを試してみてください。また、値を必要とするだけなので、範囲を互いに等しく設定することもできます。この方法では、クリップボードを使用しないでバイパスし、少し速くなります。

注：あなたが行を削除することになるだろうので、このサブを呼び出すループ内で、私は最後で始まり、トップに向かってあなたの方法を作業をお勧めします：

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

うまくいくはずです。それ以外の場合は、をCopyRowサブの末尾に追加し、iをグローバルにします。

あなただけの列-M（1〜13）をしたい場合は、あなたがどうなる：

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

（私は後方にそれを持っていること、またはiが切り替わるが、あなたのアイデアを得る必要があります）。