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

Question

我正在尝试让 VBA 扫描 DQ 列中的单元格以获取 "AcuteTransfer" 的特定文本值，然后剪切包含该单元格的行并过去到新的第一个可用行sheet.

这个值会被多次列出，每个列表都需要被剪切和粘贴

包含单元格的

sheet 是 "adds&reactivates" 并且 sheet 行将被粘贴到的位置是 "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

下一个

结束子

Answer 1

试一试 - 这是假设两个页面的第 1 行都有 headers。

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 根据单元格中的文本剪切整行并粘贴到新的 sheet

VBA Cut entire row based on text in cell and paste to new sheet

vba

cut

row

paste