Question

我正在开发一个小项目，如果我在行中检测到“true”，则需要我复制并粘贴某些列。我试图将这些选定的列粘贴到不同的工作表上，我想只粘贴它们的值而不是公式。

这是我到目前为止所得到的粘贴特殊功能错误。请帮忙。

' CopyIfTrue()
Dim Col As Range, Cell As Excel.Range, RowCount As Integer
Dim nysheet As Worksheet
Set nysheet = Sheets.Add()
nysheet.Name = "T1"

Sheets("FemImplant").Select
RowCount = ActiveSheet.UsedRange.Rows.Count

Set Col = Range("I2:I" & RowCount) 'Substitute with the range which includes your True/False values
Dim i As Integer
i = 1

For Each Cell In Col      
     If Cell.Value = "True" Then                  
        Cell.Copy
        Sheets("T1").Select 'Substitute with your sheet
        Range("b" & i).Select
        ActiveSheet.Paste

        'Get sibling cell

        Sheets("FemImplant").Select
        Dim thisRow As Integer
        thisRow = Cell.Row
        Dim siblingCell As Range
        Set siblingCell = Cells(thisRow, 2)
        siblingCell.Copy
        Sheets("T1").Select 'Substitute with your sheet
        Range("a" & i).Select
        ActiveSheet.PasteSpecial Paste:=xlPasteValues

        Sheets("FemImplant").Select
         i = i + 1
    End If
Next

Answer 1

PasteSpecial必须是Range.PasteSpecial而不是ActiveSheet.PasteSpecial。它们是不同的东西，ActiveSheet.PasteSpecial不知道任何参数“粘贴”。

ActiveSheet.Range("a" & i).PasteSpecial Paste = xlPasteValues

Answer 2

这是你在尝试的吗？

Option Explicit

Sub Sample()
    Dim rRange As Range
    Dim RowCount As Integer, i As Long
    Dim nysheet As Worksheet

    On Error Resume Next
    Application.DisplayAlerts = False
    Sheets("T1").Delete
    Application.DisplayAlerts = True
    On Error GoTo 0

    Set nysheet = Sheets.Add()
    nysheet.Name = "T1"

    With Sheets("FemImplant")
        RowCount = .Range("I" & Rows.Count).End(xlUp).Row

        .AutoFilterMode = False

        Set rRange = .Range("I2:I" & RowCount)

        With rRange
            .AutoFilter Field:=1, Criteria1:="True"

            .Offset(1, 0).SpecialCells(xlCellTypeVisible).Copy
            nysheet.Range("B1").PasteSpecial xlPasteValues

            .Offset(1, -7).SpecialCells(xlCellTypeVisible).Copy
            nysheet.Range("A1").PasteSpecial xlPasteValues
        End With

        .AutoFilterMode = False
    End With
End Sub

Answer 3

您的复制/粘贴可以大大缩短......

' CopyIfTrue()
Dim Col As Range, Cell As Excel.Range, RowCount As Integer
Dim nysheet As Worksheet, shtFI As Worksheet

Set shtFI = Sheets("FemImplant")
Set nysheet = Sheets.Add()
nysheet.Name = "T1"

RowCount = shtFI.UsedRange.Rows.Count
Set Col = shtFI.Range("I2:I" & RowCount)

Dim i As Integer
i = 1

For Each Cell In Col.Cells
     If Cell.Value = "True" Then
        Cell.Copy nysheet.Range("B" & i)
        nysheet.Range("A" & i).Value = _
                       shtFI.Cells(Cell.Row, 2).Value
        i = i + 1
    End If
Next

Answer 4

我相信您提供的代码比以前快得多。但是为了帮助其他人理解更容易，为什么不发表评论？

我已经为你做过了。

Sub ExtractData()

Dim selectedRange As Range ' Range to check
Dim Cell As Range
Dim iTotalRows As Integer ' Selected total number of rows
Dim i As Integer ' marker to identify which row to paste in new sheet

Dim shtNew As Worksheet
Dim shtData As Worksheet

Set shtData = Sheets("data")
Set shtNew = Sheets.Add()
shtNew.Name = "Analyzed data"

iTotalRows = shtData.UsedRange.Rows.count
Set selectedRange = shtData.Range("F2:F" & iTotalRows)

i = 1

' Check the selected column value one by one
For Each Cell In selectedRange.Cells

     If Cell.Value = "True" Then
        Cell.Copy shtNew.Range("A" & i)

        ' Copy the brand to column B in "Analyzed data" sheet
        shtNew.Range("B" & i).Value = _
                       shtData.Cells(Cell.Row, 2).Value
        i = i + 1
    End If

Next ' Check next cell in selected range

End Sub

在vba中粘贴特殊值

4 个答案: