セル値に基づいて1つのテーブルから別のテーブルに行をコピーするには

Question

にworkbook2のテーブルの行をコピーするには、Eのセル値に基づいてWorkbook1をコピーする必要があります。それが一致した場合、行はコピーする必要があり、それが一致したセルは、それが再び

擬似コードはコピーされないように変更する必要があります

if workbook1 sheet dispatch range E:E= 13 then copy to workbook WIP sheet1. 
AND change cell in workbook1 sheet dispatch range E:E to "131". 

私にディスパッチシート上のボタンを持っていますそれを自動的に実行させるのではなく、コードを実行してください。

ここで見つかった現在のコードは行を削除しますが、別のシートに時間が設定されており、その日の終わりにすべて印刷されるため、その行が残る必要があります。

現在のコード：

Sub MoveWaitParts() 
'move rows from sheet 1 to sheet 2 if column E has a 13 in it. 
'for Move Row into new sheet based on cell valueDim Check As Range 

lastrow = Worksheets("Dispatch").UsedRange.Rows.Count 
lastrow2 = Worksheets("wait parts").UsedRange.Rows.Count 
Dim Response As VbMsgBoxResult 

Response = MsgBox("Are you sure", vbYesNo Or vbDefaultButton2) 
If Response = vbYes Then 
If lastrow2 = 1 Then 
    lastrow2 = 0 
    Else 
End If 
Do While Application.WorksheetFunction.CountIf(Range("E:E"), "13") > 0 
    Set Check = Range("E1:E4" & lastrow) 
    For Each cell In Check 
     If cell = "13" Then 
      cell.EntireRow.Copy Destination:=Worksheets("wait parts").Range("A" & lastrow2 + 1) 
      cell.EntireRow.Delete 
      lastrow2 = lastrow2 + 1 
      Else: 
     End If 
    Next 
Loop 
End If 

End Sub 

私は私のニーズに合うように、一緒に何かをピースにコーディングして十分ではないよ、誰かが助けることができますか？

Answer 1

あなたの質問には不明な要素がいくつかありますが、これは私があなたがやろうとしていることを行うべきです。元のコードには冗長ループがいくつかあったので、以前に計算したLastRowを使ってForループを1つだけ行うのが簡単でした。しかし、そのループを "For Each Cell in Range"に簡単に変換することはできます。

Sub MoveWaitParts() 


'Set variables 
Dim i As Integer 
Dim DispatchSht As Worksheet 
Dim WaitSht As Worksheet 
Set DispatchSht = ThisWorkbook.Sheets("Dispatch") 
Set WaitSht = ThisWorkbook.Sheets("wait parts") 

'Find the last rows in each sheet 
lastrow = DispatchSht.Cells(DispatchSht.Rows.Count, "E").End(xlUp).Row 
lastrow2 = WaitSht.Cells(WaitSht.Rows.Count, "A").End(xlUp).Row 

'Confirm with user 
Dim Response As VbMsgBoxResult 
Response = MsgBox("Are you sure?", vbYesNo Or vbDefaultButton2) 

If Response = vbYes Then 
    'Not sure what this is for, but put in by OP 
    'This will overwrite the first line if there is only one line on the Wait Parts sheet 
    If lastrow2 = 1 Then 
     lastrow2 = 0 
    End If 

    'Loop through each row and see if the cell in column E = 13 
    'If it does, copy the entire row and paste it below the next row on the Wait Parts sheet 
    For i = 1 To lastrow 
    If DispatchSht.Cells(i, "E").Value = "13" Then 
     DispatchSht.Rows(i).EntireRow.Copy Destination:=WaitSht.Rows(lastrow2 + 1) 
     lastrow2 = lastrow2 + 1 

     '************Unclear question elements********* 
     '//IF THE ADDED 1 IS SOME SORT OF CODE 
     'DispatchSht.Cells(i, "E").Value = DispatchSht.Cells(i, "E").Value & "1" 
     '//IF THE ADDED 1 IS AN ARITHMETIC FUNCTION OF SOME SORT 
     'DispatchSht.Cells(i, "E").Value = DispatchSht.Cells(i, "E").Value * 10 + 1 
     '********************************************** 

    End If 
    Next i 
End If 

End Sub