Excel的VBA宏复制特定的行并删除它

Question

这里是我想做的事：

• 我有2个工作表名为待定&记录。
• 列在 “待定” 工作表：A：日期，B：货到，C：货到办公室，d：交付经理，E：主题，F：日期& G：信号
• 列在“记录“工作表：A：日期，B：Letter No. & C：主题。
• 在“Pending”工作表的单元格G（Letter No.）中输入数字时，下面的单元格将复制到“Records”工作表中指定的单元格中。
• “待定”工作表中的E（主题）位于“记录”工作表的C（主题）中。
• “待定”工作表中的F（日期）位于“记录”工作表的A（日期）中。
• “等待”工作表中的G（Letter No.）位于“记录”工作表的B（Letter No.）中。
• 删除在“待定”工作表中复制的行。
• 根据信函编号（C列）对“记录”工作表中的行进行排序。

这是我想做的事情（不工作好），我写的代码和一些截图：

Private Sub Worksheet_Change(ByVal Target As Range) 

If Target.Column = 6 Then 
    If Len(Target.Value) > 0 Then 
     Dim r As Range 
     Dim a As String 
     Dim b As String 

     b = "sheet3!A" & Sheet1.Cells(1, 9) + 3 & ":C" & Sheet1.Cells(1, 9) + 3 
     a = "E" & Target.Row & ":G" & Target.Row 
     Dim r1, r2 As Range 
     r1 = Sheet1.Range(a) 
     Sheet2.Range(b).Value = r1 
     Sheet1.Range(a).EntireRow.Delete 
    End If 
End If 

End Sub 

picture 1 picture 2

Answer 1

把下面的代码在“待定”工作表模块，在Worksheet_Change事件下。

首先，您应该学会享受Target变量的好处。例如，如果要从列“G”（您的Target）的同一行复制“F”列的值，则可以使用Target.Offset(, -1).Copy。

如果要在复制后删除整个行Target，只需使用Target.EntireRow.Delete。

另一件事，根据你的屏幕截图（和你的文章的第一部分）“Letter No”位于“记录”表中的“B”栏。因此，Sort根据“B”栏完成。

代码

Option Explicit 

Private Sub Worksheet_Change(ByVal Target As range) 

Dim RecSht  As Worksheet 
Dim NextRow  As Long 

Application.ScreenUpdating = False 
Application.EnableEvents = False 

If Target.Column = 7 Then ' Column "G" 
    If Target.Value <> "" Then 
     Set RecSht = Worksheets("Records") 
     NextRow = RecSht.Cells(RecSht.Rows.Count, "A").End(xlUp).Row + 1 ' <-- get next empty row at Column A in "Records" sheet 

     RecSht.Range("B" & NextRow).Value = Target.Value ' column "G" 
     RecSht.Range("A" & NextRow).Value = Target.Offset(, -1).Value ' column "F" 
     RecSht.Range("C" & NextRow).Value = Target.Offset(, -2).Value ' column "E" 

     Target.EntireRow.Delete ' <-- Delete entire row that was copied 

     '--- Sort Section --- 
     RecSht.Range("A2:C" & NextRow).Sort key1:=RecSht.Range("B2:B" & NextRow), _ 
             order1:=xlAscending, Header:=xlYes 
    End If 
End If 

Application.EnableEvents = True 
Application.ScreenUpdating = True 

End Sub