将整行复制到新的 sheet 并根据单元格值更改单元格值

Question

有人能帮忙吗？我有一个现有代码，它当前根据 V 列中的单元格值（已记录上诉）将整行数据从一个 sheet（质量日志）复制到另一个 sheet（上诉日志）。

之前它已从原始（质量日志）中删除了该行 sheet 但我现在正在寻找更改代码，以便将单元格值更改为（上诉中），然后将其移动到下一个 sheet（上诉记录）。

请看下面我的代码。我已经用 ** 表示我试图更改代码

    Dim xRg As Range
    Dim xCell As Range
    Dim i As Long
    Dim j As Long
    Dim K As Long
    i = Worksheets("Quality Log").UsedRange.Rows.Count
    j = Worksheets("Appeal Log").UsedRange.Rows.Count
    If j = 1 Then
       If Application.WorksheetFunction.CountA(Worksheets("Actioned").UsedRange) = 0 Then j = 0
    End If
    Set xRg = Worksheets("Quality Log").Range("V3:I" & i)
    On Error Resume Next
    Application.ScreenUpdating = False
    For K = 1 To xRg.Count
        If CStr(xRg(K).Value) = "Appeal Logged" Then
            xRg(K).EntireRow.Copy Destination:=Worksheets("Appeal Log").Range("A" & j + 1)
            **xRg(K, 22).Value = "Under Appeal"**
            
            'xRg(K).EntireRow.Delete
            If CStr(xRg(K).Value) = "Appeal Logged" Then
                K = K - 1
            End If
            j = j + 1
        End If
    Next
   
'Call ResizeArchiveTable
      
    Application.ScreenUpdating = True
End Sub```



Any and all help is much appreciated.

Answer 1

标记并复制行

Sub CopyData()
    
    Dim wb As Workbook: Set wb = ThisWorkbook ' workbook containing this code
    
    Dim sws As Worksheet: Set sws = wb.Worksheets("Quality Log")
    Dim slRow As Long: slRow = sws.UsedRange.Rows.Count
    Dim srg As Range: Set srg = sws.Range("V3:V" & slRow)
    
    Dim dws As Worksheet: Set dws = wb.Worksheets("Appeal Log")
    Dim dlRow As Long: dlRow = dws.UsedRange.Rows.Count
    Dim drrg As Range: Set drrg = dws.Rows(dlRow)
    
    Application.ScreenUpdating = False
    
    Dim sCell As Range
    Dim drCount As Long
    
    For Each sCell In srg.Cells
        If CStr(sCell.Value) = "Appeal Logged" Then
            sCell.Value = "Under Appeal"
            drCount = drCount + 1
            sCell.EntireRow.Copy drrg.Offset(drCount)
        End If
    Next sCell
    
    Application.ScreenUpdating = True

    MsgBox "Rows copied: " & drCount, vbInformation

End Sub

将整行复制到新的 sheet 并根据单元格值更改单元格值

copy entire row to a new sheet and change cell value based on cell value

excel

vba

标记并复制行