paste special values in vba

问题:

I am working on a small project which requires me to copy and paste certain columns if I detect "true" in the row. I am trying to paste these selected columns onto a different sheet and I want to paste only their values not the formulas.

This is what I have so far and I am getting an error with the paste special feature. Please help.

' 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

回答1:

PasteSpecial must be Range.PasteSpecial not ActiveSheet.PasteSpecial. They are different things and ActiveSheet.PasteSpecial does not know any parameter "Paste".

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

回答2:

Is this what you are trying?

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

回答3:

Your copy/paste can be shortened considerably...

' 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

回答4:

I believe the code you provided is much faster than earlier. However to help other understand easier, why not put some comment?

I have done that for you.

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