Question

我想修改此宏以使用原始格式粘贴复制的行，并仅将其值复制为正在复制的行中包含公式。我试过在行（j + 6）之后放置PasteSpecial xlPasteValues但是没有做到这一点。

    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

Answer 1

试试这个

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

Answer 2

尝试：

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

Answer 3

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

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

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

3 个答案: