如何根據該值將其設為單行 select？

Question

我正在努力簡化 excel 工作表，我希望根據值傳輸行中的信息。 如果值 =“完成”，我希望將其轉移到 Carc。 如果值 =“正在進行”，我希望將其轉移到 Ccon（尚未輸入）。 這已經寫在VBA中，但如果它能讓事情變得更容易，我願意嘗試其他事情。

最主要的是，我正在努力尋找一種方法，讓已經做好的代碼變得更簡單、更實用。 唯一我還沒有弄清楚的是如何讓它 select 1 行，而不是所有行。

Sub MoveBasedOnValue2()

Dim TakeCell As Range
Dim DestCell As Range

Dim Status As Range
Dim Cjob As Worksheet
Dim CArc As Worksheet

Dim Contact As Range, Subject As Range, JobNo As Range, QuoteNo As Range
Dim Dateofcommision As Range, Ddate As Range

Set Cjob = Sheet4
Set CArc = Sheet1


If Cjob.Range("G2") = "Done" Then

Set Contact = Cjob.Range("A2")
Set Subject = Cjob.Range("B2")
Set QuoteNo = Cjob.Range("C2")
Set JobNo = Cjob.Range("D2")
Set Dateofcommision = Cjob.Range("E2")
Set Ddate = Cjob.Range("F2")

Status.Select
Contact.Select
Subject.Select
QuoteNo.Select
JobNo.Select
Dateofcommision.Select
Ddate.Select

If CArc.Range("A2") = "" Then
    Set DestCell = CArc.Range("A2")
Else
    Set DestCell = CArc.Range("A1").End(xlDown).Offset(1, 0)
End If

Contact.Copy DestCell
Subject.Copy DestCell.Offset(0, 1)
QuoteNo.Copy DestCell.Offset(0, 2)
JobNo.Copy DestCell.Offset(0, 3)
Dateofcommision.Copy DestCell.Offset(0, 4)
Ddate.Copy DestCell.Offset(0, 5)

Status.ClearContents
Contact.ClearContents
Subject.ClearContents
QuoteNo.ClearContents
JobNo.ClearContents
Dateofcommision.ClearContents
Ddate.ClearContents
End If

Answer 1

你可以這樣做：

Sub MoveBasedOnValue2()

    Dim cStatus As Range, wsDest As Worksheet
    
    Set cStatus = Sheet4.Range("G2") 'first cell to check status
    
    Do While Len(cStatus.Value) > 0
        Select Case LCase(cStatus.Value)
            Case "done": Set wsDest = Sheet1
            Case "on-going": Set wsDest = Sheet2 'for example
            Case Else: Set wsDest = Nothing      'no move to make
        End Select
        
        If Not wsDest Is Nothing Then 'got a destination sheet?
            'here Range("A1:F2") is *relative* to the whole row...
            cStatus.EntireRow.Range("A1:F2").Cut _
               Destination:=wsDest.Cells(Rows.Count, "A").End(xlUp).Offset(1)
        End If
        
        Set cStatus = cStatus.Offset(1, 0) 'next source row
    Loop
End Sub