VBA将符合条件的行复制到另一个只粘贴值的工作表答案

【问题标题】：VBA copy rows that meet criteria to another sheet pasting only valuesVBA将符合条件的行复制到另一个只粘贴值的工作表
【发布时间】：2014-05-10 13:29:38
【问题描述】：

我想修改此宏以粘贴复制的行及其原始格式，并且只有它们的值，因为被复制的行中包含公式。我尝试将 PasteSpecial xlPasteValues 放在 Rows(j+6) 之后，但这并没有成功。

    Sub customcopy()
    Dim strsearch As String, lastline As Integer, tocopy As Integer

    strsearch = CStr(InputBox("enter the string to search for"))
    lastline = Range("A65536").End(xlUp).Row
    j = 1

    For i = 1 To lastline
       For Each c In Range("C" & i & ":Z" & i)
          If InStr(c.Text, strsearch) Then
               tocopy = 1
           End If
        Next c
        If tocopy = 1 Then
             Rows(i).Copy Destination:=Sheets("Sheet2").Rows(j + 6)
             j = j + 1
        End If
    tocopy = 0
    Next i

    End Sub

【问题讨论】：

您可能想在 tocopy=1 之后添加类似 exit for 的行。因为如果复制条件已经满足，为什么还要循环呢？此外，您没有声明 J. tocopy,lastline,J 因为 Long 不会造成伤害。

标签： vba excel

【解决方案1】：

试试：

Sub customcopy()
    Dim strsearch As String, lastline As Long, tocopy As Long
    strsearch = CStr(InputBox("enter the string to search for"))
    lastline = Range("A65536").End(xlUp).Row
    j = 1
    For i = 1 To lastline
       For Each c In Range("C" & i & ":Z" & i)
          If InStr(c.Text, strsearch) Then
               tocopy = 1
           End If
        Next c
        If tocopy = 1 Then
             Rows(i).Copy
             Sheets("Sheet2").Rows(j + 6).PasteSpecial (xlValues)
             Sheets("Sheet2").Rows(j + 6).PasteSpecial (xlFormats)
             j = j + 1
        End If
        tocopy = 0
    Next i
End Sub

【讨论】：

【解决方案2】：

试试这个

Sub customcopy()
Dim strsearch As String, lastline As Integer, tocopy As Integer

strsearch = CStr(InputBox("enter the string to search for"))
lastline = Range("A65536").End(xlUp).Row
j = 1

For i = 1 To lastline
   For Each c In Range("a" & i & ":a" & i)
      If InStr(c.Text, strsearch) Then
           tocopy = 1

       End If
    Next c
    If tocopy = 1 Then
         Rows(i).Copy
         Sheets("Sheet2").Rows(j + 6).PasteSpecial Paste:=xlPasteValues
         Sheets("Sheet2").Rows(j + 6).PasteSpecial Paste:=xlPasteFormats

         j = j + 1
    End If
tocopy = 0
Next i

End Sub

【讨论】：

【解决方案3】：

我确信肯定有更好的方法来保持格式并只放入值，但一个快速的解决方案可能是首先粘贴所有内容（这样你就获得了格式），然后只粘贴值：

Rows(i).Copy Destination:=Sheets("Sheet2").Rows(j + 6)
Sheets("Sheet2").Rows(j + 6).PasteSpecial Paste:=xlPasteValues

【讨论】：