选择性复制并粘贴给定条件的行 [英] Selectively copy and paste rows with given criteria

问题描述

我试图根据J列中出现的是"一词来选择表中的行.

I am trying to select rows in a table based on the word "Yes" being present in column J.

我有一个表，从A列到J列，我想选择J列中有是"的行，并将这些行仅粘贴到新表中.

I have a table going from column A to J, and I want to select the rows where there is a "Yes" in column J and paste only those rows into a new sheet.

选择后，我需要将这些行复制到新的图纸或Word文档中.

Once selected, I need to copy these rows to a new sheet or word document.

我已经尝试过使用VBA宏对Windows MS Excel软件进行一系列论坛讨论.

I have tried a range of forumulas, this is for Windows MS Excel software, using a VBA Macro.

我正在使用以下VBA，但出现问题:

I am using the following VBA, but having issues:

Sub Macro1()
 Dim rngJ As Range
    Dim cell As Range

    Set rngJ = Range("J1", Range("J65536").End(xlUp))
    Set wsNew = ThisWorkbook.Worksheets.Add

    For Each cell In rngJ
        If cell.Value = "Yes" Then
            cell.EntireRow.Copy

            wsNew.Sheets("Sheet1").Range("J65536").End(xlUp).Offset(1, 0).Select

            ActiveSheet.Paste
        End If
    Next cell

End Sub

任何帮助将不胜感激！

推荐答案

而不是为每个单元格查找，复制和粘贴，为什么不查找所有单元格，然后像这样复制并粘贴一次:

Rather than finding, copying and pasting for each cell, why not find all, then copy and paste once like this:

Sub Macro1()
Dim rngJ As Range
Dim MySel As Range

Set rngJ = Range("J1", Range("J" & Rows.Count).End(xlUp))
Set wsNew = ThisWorkbook.Worksheets.Add

For Each cell In rngJ
    If cell.Value = "Yes" Then
        If MySel Is Nothing Then
            Set MySel = cell.EntireRow
        Else
            Set MySel = Union(MySel, cell.EntireRow)
        End If
    End If
Next cell

If Not MySel Is Nothing Then MySel.Copy Destination:= wsNew.Range("A1")
End Sub

最好避免尽可能多地使用 Select ；参见此链接.

It's better to avoid using Select as much as possible; see this link.

这篇关于选择性复制并粘贴给定条件的行的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！