VB - 复制所有带有单元格的行，如''答案

【问题标题】：VB - Copy all rows with cell like ''VB - 复制所有带有单元格的行，如''
【发布时间】：2015-06-19 23:58:15
【问题描述】：

我正在尝试创建一个宏，它将在我的范围内搜索并复制像“* 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

【问题讨论】：

vb.net vba 或其他任何东西
这个地址到底是什么？ Range("iv1").End(xlToLeft).Offset(0, 1).Select 您从一个固定位置开始，进入其中的子范围（只有一个单元格，因此它将返回与您开始时相同的内容），然后从那里偏移。为什么不Range("iv2") 完成它？
为什么粘贴在循环外？
我需要 iv1 部分，因为它将新工作表粘贴到第一个空列中（第一行的第一个空单元格），因为我不知道他们将复制多少行，所以我需要它来查找下一个可用

标签： vba excel

【解决方案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

【讨论】：

这正在工作，将包含“* 01”的每一行复制到新工作表，但是当我打开一个新工作簿并运行宏时，它会复制我需要的行，但替换我需要的行已经有。所以我需要一种方法让它从第 1 行中的下一个可用单元格开始，range("iv1")xltleft 应该可以工作。看下一条评论
Sub Macro3() 'ctrl + l Dim GetBook As String Dim SrchRng As Range Dim destination As Range GetBook = ActiveWorkbook.Name Set destination = Workbooks("TestCov.xlsx").Worksheets("Sheet1" ).Range("iv1").End(xlToLeft).Offset(0, 1) 为 SrchRng 中的每个源设置 SrchRng = ActiveSheet.Range("d7:d500") If Source.Text Like "*01" Then Source. EntireRow.Copy destination.PasteSpecial _ Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:=False, Transpose:=True Set destination = destination.Offset(0, 1) End If Next Source End Sub
你可以用更好的方法替换Set destination 行。