Question

我正在尝试创建一个宏来搜索我的范围并复制像'* 01'这样的单元格的整行。它复制并粘贴到我需要的工作表，但它循环和复制只是同一行，也许我不需要循环，如果有一个更简单的方法来实现这一点。我真正需要的只是复制所有像'* 01'这样的单元格的行并将其粘贴到我的新工作表中。这将向下每5行查找具有该值的单元格。非常感谢你！

     Sub Macro3()
  'ctrl + l
  Dim GetBook As String

Dim cell As Range
Dim SrchRng As Range

GetBook = ActiveWorkbook.Name


Set SrchRng = ActiveSheet.Range("d7:d500")

Do Until IsEmpty(ActiveCell)
For Each cell In SrchRng
'And IsEmpty(ActiveCell.Offset(5, 0))
      If cell Like "*01" Then cell.Offset(0, 0).EntireRow.Copy
    Next cell

 Loop

    Windows("TestCov.xlsx").Activate
    ActiveWindow.WindowState = xlNormal

 Range("iv1").End(xlToLeft).Offset(0, 1).Select

    Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
        False, Transpose:=True

        Windows(GetBook).Activate
    ActiveCell.Offset(5, 0).Select

Answer 1

我必须完全重写。您必须编写不同的代码来设置目的地开始和搜索范围。

Sub Macro3()
    Dim SrchRng As Range
    Dim destination As Range
    Set destination = Workbooks("Book1").Worksheets("Sheet2").Range("A2")
    Set SrchRng = Workbooks("Book1").Worksheets("Sheet1").Range("A2:A500")

    For Each source In SrchRng
        If source.Text Like "*01" Then
            source.EntireRow.Copy
            destination.PasteSpecial _
                Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:=False, Transpose:=True
            Set destination = destination.Offset(1, 0)
        End If
    Next source
End Sub

VB - 复制所有行，如“＆＃39;＆＃39;

1 个答案: