Question

我正在尝试在列DQ中为特定文本值“AcuteTransfer”提供VBA扫描单元格，然后将包含该单元格的行剪切并过去到新工作表的第一个可用行中。

此值将多次列出，每个列表都需要剪切并粘贴在

上

包含该单元格的工作表是“添加并重新激活”，并且要粘贴行的工作表是“ChangeS”。

任何建议都会令人惊讶。

到目前为止我已经

了

Sub ohgodwhathaveIdone()

Dim endRow As Long
Dim Match1() As Variant
Dim ws As Worksheet
Set ws = Worksheets("adds&reactivates")
ICount = 0
endRow = Sheets("adds&reactivates").Range("DQ999999").End(xlUp).Row

Match1 = Sheet1.Range("DQ2:DQ" & endRow)
For I = LBound(Match1) To UBound(Match1)
If Match1(I, 1) = "AcuteTransfer" Then

    Sheets("adds&reactivates").Cells(I, "A").EntireRow.Copy Destination:=Sheets("changes").Range("A" & Sheets("Changes").Rows.Count).End(xlUp).Offset(1)

    Else
   End If

接下来我

End Sub

Answer 1

试试这个 - 假设两个页面都在第1行有标题。

Option Explicit
Sub Test()

Dim sht1 As Worksheet, sht2 As Worksheet
Dim i As Long

Set sht1 = ThisWorkbook.Worksheets("adds&reactivates")
Set sht2 = ThisWorkbook.Worksheets("ChangeS")

For i = 2 To sht1.Cells(sht1.Rows.Count, "DQ").End(xlUp).Row
    If sht1.Range("DQ" & i).Value = "AcuteTransfer" Then
        sht1.Range("A" & i).EntireRow.Cut sht2.Range("A" & sht2.Cells(sht2.Rows.Count, "DQ").End(xlUp).Row + 1)
    End If
Next i

End Sub

VBA根据单元格中的文本剪切整行并粘贴到新工作表

1 个答案: